Commit: 0230ea9f3e21c2e5e70adee400a0078675027710 - myprojects-hg-reborn (hg)

Commit MetaInfo

• Revision: 0230ea9f3e21c2e5e70adee400a0078675027710 (tree)
• Time: 2020-01-16 22:45:07
• Author: Lorenzo Isella <lorenzo.isella@gmai...>
• Commiter: Lorenzo Isella

Log Message

A script to make a dashboard of the balance of payments data.

Change Summary

• add: R-codes/app_fdi_quarterly.R

Incremental Difference

diff -r 7c0ecd3519ee -r 0230ea9f3e21 R-codes/app_fdi_quarterly.R
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R-codes/app_fdi_quarterly.R	Thu Jan 16 14:45:07 2020 +0100
@@ -0,0 +1,223 @@
+rm(list=ls())
+
+library(shiny)
+library(Cairo)   # For nicer ggplot2 output when deployed on Linux
+library(tidyverse)
+library(scales)
+library(DT)
+library(patchwork)
+library(viridis)
+library(scales)
+
+my_pal <- viridis(4)[1:3]
+
+my_ggplot_theme2 <- function(legend_coord){
+    theme_bw()+
+
+    theme(legend.title = element_text(vjust=1,lineheight=1, size=14 ),
+          panel.grid.minor = element_blank(),
+          plot.title = element_text(lineheight=.8, size=24, face="bold",
+          vjust=1),legend.text = element_text(vjust=.4,lineheight=1,size = 14 ),
+          axis.title.x = element_text(size = 20, vjust=1),
+                axis.title.y = element_text(size = 20, angle=90, vjust=1),
+                axis.text.x = element_text(size=15, colour="black", vjust=1),
+          axis.text.y = element_text(size=15, colour="black", hjust=1),
+                          legend.position = legend_coord,
+           strip.background = element_rect(colour = 'blue',
+                           fill = 'white', size = 1, linetype=1),
+                strip.text.x = element_text(colour = 'red', angle = 0,
+                                     size = 12, hjust = 0.5,
+                    vjust = 0.5, face = 'bold'),
+                   strip.text.y = element_text(colour = 'red', angle = 0,
+                    size = 12, hjust = 0.5,
+                    vjust = 0.5, face = 'bold'),
+     
+          )
+}
+
+
+
+df_ini <- readRDS("quarterly_BOP.RDS") %>%
+    mutate(Value=as.numeric(Value)) %>%
+    filter(complete.cases(.))  %>%
+    arrange(desc(quarter))
+
+
+reporters <- df_ini$Reporter %>% unique %>% sort
+partners <- df_ini$Partner %>% unique %>% sort
+
+
+
+ui <- fluidPage(
+
+titlePanel("Balance of Payments (BOP): Quarterly Data"),
+
+ sidebarLayout(
+        sidebarPanel(
+    selectInput("reporterlabel",
+            "Reporter:",
+            reporters,
+            selected="European Union - 28 countries"
+            ## , multiple=T
+            ),
+selectInput("partnerlabel",
+            "Partner:",
+            partners ,
+            selected="China except Hong Kong"
+            ),
+
+downloadButton("downloadData", "Download data selection"),
+ downloadButton("save", "Download plot"),
+ downloadButton("saveall", "Download full dataset"),
+
+h3("Data source: EUROSTAT"),
+h4("Last updated: 16/01/2020")
+
+
+),
+
+mainPanel(
+          ## h2("Evolution of Stocks and Flows"),
+    plotOutput("tradeplot" ## ,
+                ## hover = "plot_hover"
+               ## click = "plot_click"
+               ) ,
+    ## DTOutput("info")   #### <- CHANGED THIS ####
+    tableOutput("table")
+
+)
+
+)
+)
+
+
+
+
+server <- function(input, output) {
+
+
+    dataset <- reactive({ df_ini %>%
+                              select(-quarter) %>%
+                              arrange(Reporter, Partner)
+                              })
+
+
+    filtered_data <- reactive({
+
+      df_ini %>% filter(Reporter %in% input$reporterlabel,
+                        Partner %in% input$partnerlabel) %>%
+          arrange(desc(quarter))
+              
+              
+    })
+
+
+    filtered2 <-  reactive({
+        filtered_data() %>%
+            select(-quarter) %>%
+            rename("Value (Mio \u20ac)"="Value")
+        })
+
+
+    filtered3 <-  reactive({
+        filtered_data() %>%
+            select(-quarter) %>%
+            mutate(Value=comma(Value, accuracy=1)) %>% 
+            rename("Value (Mio \u20ac)"="Value")
+
+        })
+    
+
+  tradeplot <- reactive({
+    options( scipen = 16 )
+
+    my_rep <- filtered_data()$Reporter[1]
+
+    my_par <- filtered_data()$Partner[1]
+
+
+    ### I add a trimester on the x axis to avoid ugly looking cutoff of the year.
+    my_min <- min(filtered_data()$quarter)
+    my_max <- max(filtered_data()$quarter+90)
+    
+    filtered_data() %>%
+        ggplot(aes(x =quarter , y = Value, color=Flow, shape=Flow,
+                   linetype=Flow)) +
+        geom_line(size=1.)+
+        geom_point(size=3,  stroke=2)+
+      my_ggplot_theme2("top")+
+      scale_color_manual(NULL, ## labels=c("Inward Stocks","Outward Stocks" ),
+                         values=my_pal)+
+      scale_shape_manual(NULL, ## labels=c("Inward Stocks","Outward Stocks" ),
+                         values=c(1,2,3))+  
+      scale_linetype_manual(NULL, ## labels=c("Inward Stocks","Outward Stocks" ),
+                            values=c(1,2,3))+
+        
+    
+        scale_y_continuous(labels=function(x) format(x, big.mark = ",",
+                                                     scientific = FALSE),breaks=pretty_breaks(n=5))+
+        
+      scale_x_date(breaks = pretty_breaks(n=6), limits=(c(my_min, my_max)))+
+      xlab(NULL)+
+      ylab("Value of BOP (Mio \u20ac)") +
+      labs(title = paste("Reporter: ", my_rep, "\nPartner: ", my_par))
+
+      })
+
+
+
+        output$tradeplot <- renderPlot({
+tradeplot()
+    }
+)
+
+
+  # Downloadable csv of selected dataset ----
+  output$downloadData <- downloadHandler(
+    filename = function() {
+      paste("data_extraction", ".csv", sep = "")
+
+    },
+    content = function(file) {
+      write.csv(filtered2(), file, row.names = FALSE)
+    }
+  )
+
+
+    
+
+output$save <- downloadHandler(
+    filename = "save.png" ,
+    content = function(file) {
+     ggsave(tradeplot(), filename = file, width=12, height=6)
+     
+    })
+
+
+
+      # Downloadable csv of full dataset ----
+  output$saveall <- downloadHandler(
+    filename = function() {
+      ## paste(input$dataset, ".csv", sep = "")
+      paste("complete_dataset", ".csv", sep = "")
+
+    },
+    content = function(file) {
+      write.csv(dataset(), file, row.names = FALSE)
+    }
+  )
+
+
+
+    output$table <- renderTable(dd <- filtered3()##  %>%
+                                    ## mutate_all(as.character)
+                                 )  
+
+
+    
+}
+
+
+
+shinyApp(ui = ui, server = server)
+