delete comments, break down server in multiple files

ipeaGIT · Mar 16, 2020 · 94da6ca · 94da6ca
1 parent da0cacc
commit 94da6ca
Show file tree

Hide file tree

Showing 7 changed files with 803 additions and 993 deletions.
diff --git a/atlasacessibilidade/global.R b/atlasacessibilidade/global.R
@@ -1,3 +1,5 @@
+
+# load packages ---------------------------
 library(shiny)
 library(shinyWidgets)
 library(mapdeck)
@@ -9,18 +11,20 @@ library(data.table)
 library(waiter) # remotes::install_github("JohnCoene/waiter")
 library(shiny.i18n)
 
-# new
 library(ggplot2)
 library(forcats)
 library(highcharter)
 library(hrbrthemes) # remotes::install_github("hrbrmstr/hrbrthemes")
 library(ggalt) # install.packages("ggalt", dependecies = TRUE)
 library(tidyr)
 
+# load translator data ---------------------------
 translator <- Translator$new(translation_json_path = "data/translation.json")
 
+# load functions ---------------------------
 source("R/create_radio_button_custom.R")
 source("R/label_with_info.R")
+source("R/slider_input_acess.R")
 
 # Use GForce Optimisations in data.table operations
 options(datatable.optimize=Inf)
@@ -29,31 +33,6 @@ options(datatable.optimize=Inf)
 data.table::setDTthreads(percent = 100)
 
 
-# register mapbox api key
+# register mapbox api key ---------------------------
 # set_token("")
 set_token("pk.eyJ1Ijoia2F1ZWJyYWdhIiwiYSI6ImNqa2JoN3VodDMxa2YzcHFxMzM2YWw1bmYifQ.XAhHAgbe0LcDqKYyqKYIIQ")
-
-source("R/slider_input_acess.R")
-
-# TIMEOUT -------------------------------------------------------------------------------------
-
-timeoutSeconds <- 20
-
-inactivity <- sprintf("function idleTimer() {
-var t = setTimeout(logout, %s);
-window.onmousemove = resetTimer; // catches mouse movements
-window.onmousedown = resetTimer; // catches mouse movements
-window.onclick = resetTimer;     // catches mouse clicks
-window.onscroll = resetTimer;    // catches scrolling
-window.onkeypress = resetTimer;  //catches keyboard actions
-
-function logout() {
-Shiny.setInputValue('timeOut', '%ss')
-}
-
-function resetTimer() {
-clearTimeout(t);
-t = setTimeout(logout, %s);  // time is in milliseconds (1000 is 1 second)
-}
-}
-idleTimer();", timeoutSeconds*1000, timeoutSeconds, timeoutSeconds*1000)
diff --git a/atlasacessibilidade/modules/download_button.R b/atlasacessibilidade/modules/download_button.R
@@ -0,0 +1,233 @@
+# prepare data to be downloaded
+prepare_data_download <- reactive({
+
+  # select data 
+
+  if (input$graph_type %in% c("palma_renda", "palma_cor")) {
+
+
+    data_out <- tempo_filtrado_graph()
+
+  } 
+  else if (input$graph_type %in% c("dumbell_renda", "dumbell_cor")) {
+
+    data_out <- atividade_filtrada_graph()
+
+  }
+
+  # define attributes name based on language
+  attributes_lookup <- data.frame(atividade = c("TT", "ST", "SB", "SM", "SA", "ET", "EI", "EF", "EM"), 
+                                  nome = c(i18n()$t("trabalho_total"), 
+                                           i18n()$t("saude_total"),
+                                           i18n()$t("saude_baixa"),
+                                           i18n()$t("saude_media"),
+                                           i18n()$t("saude_alta"),
+                                           i18n()$t("educacao_total"),
+                                           i18n()$t("educacao_infantil"),
+                                           i18n()$t("educacao_fundamental"),
+                                           i18n()$t("educacao_media")))
+
+  output_csv_palma <- data_out %>%
+    mutate(modo = case_when(
+      modo == 'bicicleta' ~ i18n()$t('bicicleta'),
+      modo == 'caminhada' ~ i18n()$t('caminhada'),
+      modo == 'tp' ~ i18n()$t('tp'))) %>%
+    left_join(attributes_lookup, by = "atividade")
+
+
+  # define column names based on language
+  if (input$graph_type %in% c("palma_renda", "palma_cor")) {
+
+    output_csv_palma <- output_csv_palma %>% select(nome_muni, sigla_muni, modo, indicador, atividade = nome, 
+                                                    tempo_viagem, pobre, rico, palma_ratio)
+
+    colnames(output_csv_palma) <- c(i18n()$t("nome_muni"),
+                                    i18n()$t("sigla_muni"),
+                                    i18n()$t("modo"),
+                                    i18n()$t("indicador"),
+                                    i18n()$t("atividade"),
+                                    i18n()$t("tempo_viagem"),
+                                    "low",
+                                    "high",
+                                    "ratio") 
+
+  }
+
+  else if (input$graph_type %in% c("dumbell_renda", "dumbell_cor")) {
+
+    # define column names based on language
+
+    output_csv_palma <- output_csv_palma %>% select(nome_muni, sigla_muni, modo, indicador, atividade = nome, total, low, high)
+
+    colnames(output_csv_palma) <- c(i18n()$t("nome_muni"),
+                                    i18n()$t("sigla_muni"),
+                                    i18n()$t("modo"),
+                                    i18n()$t("indicador"),
+                                    i18n()$t("atividade"),
+                                    "total",
+                                    "low",
+                                    "high"
+    )
+
+  }
+
+  return(output_csv_palma)
+
+})
+
+
+
+# UI FOR THE DOWNLOAD BUTTONS -----------------------------------------------------------------
+
+output$ui_download_button <- renderUI({
+
+  tagList(
+    downloadButton("downloadData", i18n()$t("Baixe os dados (.csv)")),
+    downloadButton("downloadPlot", i18n()$t("Baixe o gŕafico (.png)"))
+  )
+
+})  
+
+# UI FOR THE DOWNLOAD BUTTONS - dictionary -----------------------------------------------------------------
+
+output$ui_download_dic <- renderUI({
+
+  downloadButton("downloadDic", i18n()$t("Baixe o dicionário dos dados (.xlsx)"))
+
+})  
+
+
+# data
+output$downloadData <- downloadHandler(
+
+
+
+  # generate button with data
+  filename = function() {
+
+    if (input$graph_type %in% c("palma_renda", "palma_cor")) {
+
+      sprintf("acess_%s_%s_%s_%s.csv", i18n()$t(input$graph_type), i18n()$t(input$modo_todos_graph), 
+              input_atividade_graph(), input_tempo_graph())
+
+    } 
+    else if (input$graph_type %in% c("dumbell_renda", "dumbell_cor")) {
+
+      sprintf("acess_%s_%s_%s.csv", i18n()$t(input$graph_type), 
+              i18n()$t(input$modo_todos_graph), input_atividade_graph())
+
+    }
+
+  },
+  content = function(file) {
+
+    write.csv(prepare_data_download(), file, row.names = FALSE, quote = FALSE)
+
+  }
+
+
+)
+
+# plot
+output$downloadPlot <- downloadHandler(
+  filename = function() {
+
+
+    if (input$graph_type %in% c("palma_renda", "palma_cor")) {
+
+      sprintf("acess_%s_%s_%s_%s.png", i18n()$t(input$graph_type), 
+              i18n()$t(input$modo_todos_graph), input_atividade_graph(), input_tempo_graph())
+
+    } 
+    else if (input$graph_type %in% c("dumbell_renda", "dumbell_cor")) {
+
+      sprintf("acess_%s_%s_%s.png", i18n()$t(input$graph_type), 
+              i18n()$t(input$modo_todos_graph), input_atividade_graph())
+
+    }
+
+  },
+  content = function(file) {
+
+
+    if (input$graph_type %in% c("palma_renda", "palma_cor")) {
+
+
+      title_plot <- sprintf("%s %s %s %s %s %s", make_title_plots()$graph, make_title_plots()$modo, 
+                            make_title_plots()$atividade, i18n()$t("em"), 
+                            input_tempo_graph(), i18n()$t("minutos"))
+      legend_plot <- switch(input$graph_type, 
+                            "palma_renda" = i18n()$t("Razão da acessibilidade cumulativa dos 10% mais ricos pelos 40% mais pobres"), 
+                            "palma_cor" = i18n()$t("Razão da acessibilidade cumulativa da população branca pela população negra")) 
+
+      new_save <- tempo_filtrado_graph() %>%
+        mutate(nome_muni = factor(nome_muni)) %>%
+        mutate(nome_muni = forcats::fct_reorder(nome_muni, palma_ratio))
+
+      plot_save <- ggplot(data = new_save)+
+        geom_col(aes(y = palma_ratio, x = nome_muni), fill = "#1D5A79") +
+        geom_text(aes(y = palma_ratio, x = nome_muni, label = round(palma_ratio,1)), 
+                  size = 3, position = position_stack(vjust = 0.88), color='gray99') +
+        geom_hline(yintercept = 1, color = "grey90", linetype = "dashed") +
+        scale_y_continuous(breaks = c(0, 1, 3, 6, 9))+
+        coord_flip()+
+        theme_ipsum(grid = "X", base_family = "Helvetica")+
+        labs(x = "", y = ifelse(input$graph_type == "palma_renda", i18n()$t("Razão de Palma"), i18n()$t("Razão de Desigualdade por Cor")),
+             title = title_plot,
+             subtitle = legend_plot,
+             caption = i18n()$t("Projeto Acesso a Oportunidades - IPEA")
+        )+
+        theme(plot.title = element_text(size=9, hjust=0),
+              plot.subtitle = element_text(size = 7, hjust=0),
+              plot.caption = element_text(size=7),
+              axis.text.y = element_text(size = 6),
+              axis.text.x = element_text(size = 6),
+              axis.title.x = element_text(size = 6),
+              legend.text = element_text(size = 7),
+              plot.margin = unit(c(3,3,3,3), "mm"))
+
+    } 
+
+
+    else if (input$graph_type %in% c("dumbell_renda", "dumbell_cor")) {
+
+
+      title_plot <- sprintf("%s %s %s", make_title_plots()$graph, 
+                            make_title_plots()$modo, make_title_plots()$atividade)
+      legend_plot <- switch(input$graph_type, 
+                            "dumbell_renda" = i18n()$t("Média do tempo mínimo de viagem por renda"), 
+                            "dumbell_cor" = i18n()$t("Média do tempo mínimo de viagem por cor")) 
+
+      new_save <- atividade_filtrada_graph() %>%
+        mutate(nome_muni = factor(nome_muni))
+
+      # para plotar as legendas
+      new_save_legend <- new_save %>% tidyr::gather(tipo, valor, total:high)
+
+      plot_save <- ggplot(data = new_save) + 
+        geom_dumbbell(aes(x = high, xend = low, y = forcats::fct_reorder(nome_muni, low)), 
+                      size=2, color="gray80", alpha=.8, colour_x = "steelblue4", colour_xend = "springgreen4") +
+        geom_point(data = new_save_legend, aes(x = valor, y = nome_muni, color = tipo), size = 2)+
+        scale_color_manual(values=c('black', 'steelblue4', 'springgreen4'), 
+                           name="", 
+                           labels=c('Total', 
+                                    ifelse(input$graph_type == "dumbell_renda", i18n()$t("Pobres Q1"), i18n()$t("Negros")), 
+                                    ifelse(input$graph_type == "dumbell_renda", i18n()$t("Ricos Q5"), i18n()$t("Brancos")))) +
+        theme_ipsum(grid= "X", base_family = "Helvetica") +
+        labs(x = i18n()$t("Minutos"), y = "", title = title_plot, subtitle = legend_plot)+
+        theme(plot.title = element_text(size=9, hjust=0),
+              plot.subtitle = element_text(size = 7, hjust=0),
+              plot.caption = element_text(size=7),
+              axis.text.y = element_text(size = 6),
+              axis.text.x = element_text(size = 6),
+              axis.title.x = element_text(size = 7),
+              plot.margin = unit(c(3,3,3,3), "mm"),
+              legend.text = element_text(size = 7),
+              legend.position = "bottom")
+
+    }
+
+    ggsave(filename = file, plot = plot_save, dpi = 300, width = 16.5, height = 10, units = "cm")
+
+  }
+)