diff --git a/atlasacessibilidade/global.R b/atlasacessibilidade/global.R index bdc520e..412b275 100755 --- a/atlasacessibilidade/global.R +++ b/atlasacessibilidade/global.R @@ -1,3 +1,5 @@ + +# load packages --------------------------- library(shiny) library(shinyWidgets) library(mapdeck) @@ -9,7 +11,6 @@ library(data.table) library(waiter) # remotes::install_github("JohnCoene/waiter") library(shiny.i18n) -# new library(ggplot2) library(forcats) library(highcharter) @@ -17,10 +18,13 @@ 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 new file mode 100644 index 0000000..d484ae4 --- /dev/null +++ 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") + + } +) diff --git a/atlasacessibilidade/modules/graphs_server.R b/atlasacessibilidade/modules/graphs_server.R new file mode 100644 index 0000000..3b0ce60 --- /dev/null +++ b/atlasacessibilidade/modules/graphs_server.R @@ -0,0 +1,249 @@ +# Reactive para a modo +modo_filtrado_graph <- reactive({ + + + if (input$graph_type == "palma_renda") { + + aa <- palma_renda[modo == input$modo_todos_graph] + + } else if (input$graph_type == "palma_cor") { + + aa <- palma_cor[modo == input$modo_todos_graph] + + } else if (input$graph_type == "dumbell_renda") { + + aa <- dumbell_renda[modo == input$modo_todos_graph] + + } else if (input$graph_type == "dumbell_cor") { + + aa <- dumbell_cor[modo == input$modo_todos_graph] + + } + +}) + +# Reative to activity +# Reative to time threshold +input_atividade_graph <- reactive({ + + if(input$graph_type %in% c("palma_renda", "palma_cor")) {input$atividade_graph_cum} else {input$atividade_graph_tmi} + +}) + + +atividade_filtrada_graph <- reactive({ + + bb <- modo_filtrado_graph()[atividade == input_atividade_graph()] + + return(bb) + +}) + +# Reative to time threshold +input_tempo_graph <- reactive({ + + if(input$modo_todos_graph %in% c("caminhada", "bicicleta")) {input$tempo_ativo_graph} else {input$tempo_tp_graph} + +}) + +tempo_filtrado_graph <- reactive({ + + cc <- atividade_filtrada_graph()[tempo_viagem == input_tempo_graph()] + +}) + + + +make_title_plots <- reactive({ + + # make title plot + title_plot_graph <- switch(input$graph_type, + "palma_renda" = i18n()$t("Desigualdade por renda"), + "palma_cor" = i18n()$t("Desigualdade por cor"), + "dumbell_renda" = i18n()$t("Desigualdade por renda"), + "dumbell_cor" = i18n()$t("Desigualdade por cor")) + + title_plot_modo <- switch(input$modo_todos_graph, + "tp" = i18n()$t("por transporte público"), + "caminhada" = i18n()$t("por caminhada"), + "bicicleta" = i18n()$t("por bicicleta")) + + title_plot_atividade <- switch(input_atividade_graph(), + "TT" = switch(input$graph_type, + "palma_renda" = i18n()$t("para trabalho"), + "palma_cor" = i18n()$t("para trabalho"), + "dumbell_renda" = "vazio", + "dumbell_cor" = "vazio"), + "ET" = switch(input$graph_type, + "palma_renda" = i18n()$t("para educação"), + "palma_cor" = i18n()$t("para educação"), + "dumbell_renda" = i18n()$t("à escola mais próxima"), + "dumbell_cor" = i18n()$t("à escola mais próxima")), + "EI" = switch(input$graph_type, + "palma_renda" = i18n()$t("para educação infantil"), + "palma_cor" = i18n()$t("para educação infantil"), + "dumbell_renda" = i18n()$t("à escola infantil mais próxima"), + "dumbell_cor" = i18n()$t("à escola infantil mais próxima")), + "EF" = switch(input$graph_type, + "palma_renda" = i18n()$t("para educação fundamental"), + "palma_cor" = i18n()$t("para educação fundamental"), + "dumbell_renda" = i18n()$t("à escola fundamental mais próxima"), + "dumbell_cor" = i18n()$t("à escola fundamental mais próxima")), + "EM" = switch(input$graph_type, + "palma_renda" = i18n()$t("para educação média"), + "palma_cor" = i18n()$t("para educação média"), + "dumbell_renda" = i18n()$t("à escola média mais próxima"), + "dumbell_cor" = i18n()$t("à escola média mais próxima")), + "ST" = switch(input$graph_type, + "palma_renda" = i18n()$t("para saúde"), + "palma_cor" = i18n()$t("para saúde"), + "dumbell_renda" = i18n()$t("ao equipamento de saúde mais próximo"), + "dumbell_cor" = i18n()$t("ao equipamento de saúde mais próximo")), + "SB" = switch(input$graph_type, + "palma_renda" = i18n()$t("para saúde baixa"), + "palma_cor" = i18n()$t("para saúde baixa"), + "dumbell_renda" = i18n()$t("ao equipamento de saúde baixo mais próximo"), + "dumbell_cor" = i18n()$t("ao equipamento de saúde baixo mais próximo")), + "SM" = switch(input$graph_type, + "palma_renda" = i18n()$t("para saúde média"), + "palma_cor" = i18n()$t("para saúde média"), + "dumbell_renda" = i18n()$t("ao equipamento de saúde médio mais próximo"), + "dumbell_cor" = i18n()$t("ao equipamento de saúde médio mais próximo")), + "SA" = switch(input$graph_type, + "palma_renda" = i18n()$t("para saúde alta"), + "palma_cor" = i18n()$t("para saúde alta"), + "dumbell_renda" = i18n()$t("ao equipamento de saúde alta mais próximo"), + "dumbell_cor" = i18n()$t("ao equipamento de saúde alta mais próximo"))) + + title_plot_df <- data.frame(graph = title_plot_graph, + modo = title_plot_modo, + atividade = title_plot_atividade) + + print(title_plot_df$graph) + print(title_plot_df$modo) + print(title_plot_df$atividade) + + return(title_plot_df) + + +}) + + +# Render graphs +output$output_graph <- renderHighchart({ + + + # GRAPH FOR PALMA RATIO + if (input$graph_type %in% c("palma_renda", "palma_cor")) { + + new <- tempo_filtrado_graph() %>% + mutate(nome_muni = factor(nome_muni)) + + new <- arrange(new, desc(palma_ratio)) + + + 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")) + + print(title_plot) + print(legend_plot) + + + hchart(new, "bar", hcaes(x = nome_muni, y = palma_ratio), + name = "Palma Ratio") %>% + hc_title(text = title_plot, + align = "left", x = 50) %>% + hc_subtitle(text = legend_plot, + align = "left", x = 50) %>% + hc_xAxis(opposite = FALSE, + title = list(text = "") + , labels = list( + # format = "{value}%", + style = list(fontSize = 15)) + ) %>% + hc_yAxis(title = list(text = ifelse(input$graph_type == "palma_renda", + i18n()$t("Razão de Palma"), + i18n()$t("Razão de Desigualdade por Cor")))) %>% + # change bar colors + hc_colors(colors = "#1D5A79") %>% + # change font + hc_chart(style = list(fontFamily = "Roboto Condensed")) %>% + # add vertical line + hc_yAxis(plotLines = list(list(color = "#99A3A4", value = 1, width = 2, zIndex = 5, dashStyle = "LongDash"))) %>% + hc_exporting(enabled = FALSE) %>% + # add data label at the end of each bar (with values) + hc_plotOptions(bar = list(dataLabels = list(enabled = TRUE, + align = "right", + x = -5, + style = list(fontSize = 15, + color = "white", + textOutline = "0.3px white", + fontWeight = "regular")))) + + } 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")) + + + # arrange by Q1 + + teste_dumbell <- arrange(atividade_filtrada_graph(), -low) + + highchart() %>% + hc_xAxis(categories = teste_dumbell$nome_muni, labels = list(style = list(fontSize = 15))) %>% + hc_yAxis(min = 0, labels = list(style = list(fontSize = 15)), title = list(text = i18n()$t("Minutos"))) %>% + hc_chart(inverted = TRUE) %>% + hc_title(text = title_plot, + align = "left", x = 25) %>% + # change font + hc_chart(style = list(fontFamily = "Roboto Condensed")) %>% + hc_subtitle(text = legend_plot, + align = "left", x = 25) %>% + hc_legend(itemStyle = list(fontSize = 15)) %>% + # add bar + hc_add_series(data = teste_dumbell, + type = "errorbar", + color = "#95A5A6", + lineWidth = 5, + opacity = 0.5, + name = "", + tooltip = list(enabled = TRUE, + valueDecimals = 0), + whiskerWidth = 0) %>% + # add total + hc_add_series(data = teste_dumbell$total, + type = "scatter", + color = "black", + name = "Total", + size = 5, + marker = list(radius = 7), + tooltip = list(pointFormat = sprintf("%s: {point.y}", i18n()$t("Valor")), + valueDecimals = 0)) %>% + # add Q1 + hc_add_series(data = teste_dumbell$low, + type = "scatter", + color = "#008B45", + name = ifelse(input$graph_type == "dumbell_renda", i18n()$t("Pobres Q1"), i18n()$t("Negros")), + marker = list(radius = 7, symbol = "circle"), + tooltip = list(pointFormat = sprintf("%s: {point.y}", i18n()$t("Valor")), + valueDecimals = 0)) %>% + # add Q5 + hc_add_series(data = teste_dumbell$high, + type = "scatter", + color = "#36648B", + name = ifelse(input$graph_type == "dumbell_renda", i18n()$t("Ricos Q5"), i18n()$t("Brancos")), + marker = list(radius = 7, symbol = "circle"), + tooltip = list(pointFormat = sprintf("%s: {point.y}", i18n()$t("Valor")), + valueDecimals = 0)) + + + } + + +}) diff --git a/atlasacessibilidade/modules/map_server.R b/atlasacessibilidade/modules/map_server.R new file mode 100644 index 0000000..4d847bf --- /dev/null +++ b/atlasacessibilidade/modules/map_server.R @@ -0,0 +1,282 @@ +# MAPS SERVER --------------------------------------------------------------------------------- + +# 1) REACTIVE TO FILTER THE CITY ----------------------------------------------------------------- +a_city <- reactive({ + + if(input$cidade != "") {input$cidade} else {"fake"} + + +}) + +cidade_filtrada <- reactive({ + + acess[sigla_muni == a_city()] + +}) + + + +# 2) REACTIVE TO FILTER THE MODE ----------------------------------------------------------------- +a <- reactive({ + + if (a_city() %in% c('for', 'spo', 'rio', 'cur', 'poa', 'bho', 'rec')) {input$modo_todos} + + else if(a_city() %in% c('bsb', 'sal', 'man', 'goi', 'bel', 'gua', 'cam', 'slz', 'sgo', 'mac', 'duq', 'cgr', 'nat', 'fake')) { + + # # Reactive para a modo para indicador cumulativo + input$modo_ativo } + +}) + +# Reactive para a modo +modo_filtrado <- reactive({ + + cidade_filtrada()[modo == a()] + +}) + +# 3) REACTIVE TO FILTER THE INDICATOR ------------------------------------------------------------ +indicador_filtrado <- reactive({ + + modo_filtrado() %>% dplyr::select(id_hex, P001, matches(input$indicador)) + +}) + + +# 4) REACTIVE TO FILTER THE ACTIVITY ------------------------------------------------------------ +# Reactive para a atividade para indicador cumulativo +atividade_filtrada <- reactive({ + + indicador_filtrado() %>% dplyr::select(id_hex, P001, matches(input$atividade_cum)) + +}) + + +# Reactive para a atividade para indicador tempo minimo +atividade_filtrada_min <- reactive({ + + indicador_filtrado() %>% dplyr::select(id_hex, P001, matches(input$atividade_min)) %>% + rename(id_hex = 1, P001 = 2, valor = 3) %>% + mutate(id = 1:n()) %>% + mutate(popup = paste0(i18n()$t("População: "), P001, i18n()$t("
Valor da acessibilidade: "), round(valor, 0), " ", i18n()$t("minutos"))) + +}) + + +# 5) REACTIVE TO FILTER THE TIME THRESHOLD ------------------------------------------------------- + +# Select time threshold +b <- reactive({ + + if (a_city() %in% c('for', 'spo', 'rio', 'cur', 'poa', 'bho', 'rec') & input$modo_todos %in% "tp") {input$tempo_tp} + + else if (a_city() %in% c('for', 'spo', 'rio', 'cur', 'poa', 'bho', 'rec') & input$modo_todos %in% c("caminhada", "bicicleta")) {input$tempo_ativo_tp} + + else if (a_city() %in% c('bsb', 'sal', 'man', 'goi', 'bel', 'gua', 'cam', 'slz', 'sgo', 'mac', 'duq', 'cgr', 'nat', 'fake')) {input$tempo_ativo} + +}) + +# Reactive for time threshold +tempo_filtrado <- reactive({ + + atividade_filtrada() %>% dplyr::select(id_hex, P001, matches(as.character(b()))) %>% + rename(id_hex = 1, P001 = 2, valor = 3) %>% + mutate(id = 1:n()) %>% + # create popup + mutate(popup = paste0(i18n()$t("População: "), P001, i18n()$t("
Valor da acessibilidade: "), round(valor, 1), "%")) + +}) + +# 6) TRANSFORM TO SF ----------------------- + +atividade_filtrada_min_sf <- reactive({ + + atividade_filtrada_min() %>% setDT() %>% + merge(hex, by = "id_hex", all.x = TRUE, sort = FALSE) %>% + st_sf(crs = 4326) + +}) + + +tempo_filtrado_sf <- reactive({ + + tempo_filtrado() %>% setDT() %>% + merge(hex, by = "id_hex", all.x = TRUE, sort = FALSE) %>% + st_sf(crs = 4326) + + +}) + + + + +# 7) RENDER BASEMAP ------------------------------------------------------- +# baseMap +output$map <- renderMapdeck({ + + mapdeck(location = c(-43.95988, -19.902739), zoom = 3) + + +}) + + +# Stop the loading page here ! +waiter_hide() + + +# 8) OBSERVER TO RENDER THE CITY INDICATOR ------------------------------------------------------- +observeEvent({input$cidade},{ + + + # Filtrar limites + limits_filtrado <- filter(limits, abrev_muni == input$cidade) + + if (input$cidade != "") { + + centroid_go <- filter(centroids, abrev_muni == input$cidade) + + if(input$cidade %in% c("spo", "man", "cgr", "bsb")) { + + zoom1 <- 9 + + } else if(input$cidade %in% c("mac", "for", "nat", "rec", "sal", "slz", "bho")) { + + zoom1 <- 11 + + } else {zoom1 <- 10} + + proxy <- mapdeck_update(map_id = "map") %>% + mapdeck_view(location = c(centroid_go$lon, centroid_go$lat), zoom = zoom1, + duration = 3000, transition = "fly") + + if (input$indicador == "CMA") { + + proxy %>% + clear_polygon(layer_id = "acess_min_go") %>% + clear_legend(layer_id = "acess_min_go") %>% + add_polygon( + data = limits_filtrado, + stroke_colour = "#616A6B", + stroke_width = 100, + fill_opacity = 0, + update_view = FALSE, + focus_layer = FALSE, + ) %>% + add_polygon( + data = tempo_filtrado_sf(), + fill_colour = "valor", + fill_opacity = 200, + layer_id = "acess_cum_go", + palette = "inferno", + update_view = FALSE, + focus_layer = FALSE, + # auto_highlight = TRUE, + tooltip = "popup", + legend = TRUE, + legend_options = list(title = i18n()$t("Porcentagem de Oportunidades Acessíveis")), + legend_format = list( fill_colour = as.integer) + ) + + + } else if (input$indicador == "TMI") { + + # create viridis scale in the reverse direction + # create matrix + colorss <- colourvalues::color_values_rgb(x = 1:256, "viridis") + # invert matrix + colorss <- apply(colorss, 2, rev)[, 1:3] + + proxy %>% + clear_polygon(layer_id = "acess_cum_go") %>% + clear_legend(layer_id = "acess_cum_go") %>% + add_polygon( + data = limits_filtrado, + stroke_colour = "#616A6B", + stroke_width = 100, + fill_opacity = 0, + update_view = FALSE, + focus_layer = FALSE + ) %>% + add_polygon( + data = atividade_filtrada_min_sf(), + fill_colour = "valor", + fill_opacity = 200, + layer_id = "acess_min_go", + palette = colorss, + update_view = FALSE, + tooltip = "popup", + legend = TRUE, + legend_options = list(title = i18n()$t("Minutos até a oportunidade mais próxima")), + legend_format = list( fill_colour = as.integer) + ) + + } + + + } + + + +}) + + +observeEvent({c(input$indicador, + input$modo_todos, input$modo_ativo, + input$atividade_cum, input$atividade_min, + input$tempo_tp, input$tempo_ativo_tp, input$tempo_ativo)},{ + + + if (a_city() != "fake") { + + + if (input$indicador == "TMI") { + + # create viridis scale in the reverse direction + # create matrix + colorss <- colourvalues::color_values_rgb(x = 1:256, "viridis") + # invert matrix + colorss <- apply(colorss, 2, rev)[, 1:3] + + mapdeck_update(map_id = "map") %>% + clear_polygon(layer_id = "acess_cum_go") %>% + clear_legend(layer_id = "acess_cum_go") %>% + add_polygon( + data = atividade_filtrada_min_sf(), + fill_colour = "valor", + fill_opacity = 200, + layer_id = "acess_min_go", + palette = colorss, + update_view = FALSE, + tooltip = "popup", + legend = TRUE, + legend_options = list(title = i18n()$t("Minutos até a oportunidade mais próxima")), + legend_format = list( fill_colour = as.integer) + ) + + } else + + if (input$indicador == "CMA") { + + mapdeck_update(map_id = "map") %>% + clear_polygon(layer_id = "acess_min_go") %>% + clear_legend(layer_id = "acess_min_go") %>% + add_polygon( + data = tempo_filtrado_sf(), + fill_colour = "valor", + fill_opacity = 200, + layer_id = "acess_cum_go", + palette = "inferno", + update_view = FALSE, + focus_layer = FALSE, + # auto_highlight = TRUE, + tooltip = "popup", + legend = TRUE, + legend_options = list(title = i18n()$t("Porcentagem de Oportunidades Acessíveis")), + legend_format = list( fill_colour = as.integer) + ) + } + + + } + }) + diff --git a/atlasacessibilidade/modules/map_ui.R b/atlasacessibilidade/modules/map_ui.R index e8e0780..31d5657 100755 --- a/atlasacessibilidade/modules/map_ui.R +++ b/atlasacessibilidade/modules/map_ui.R @@ -91,8 +91,10 @@ output$page_content <- renderUI({ # 2. INDICATOR SELECTION -------------------------------------------------- awesomeRadio(inputId = "indicador", - label = label_with_info(label = i18n()$t("Escolha o indicador de acessibilidade"), - tooltip_id = "q1"), + label = label_with_info( + label = i18n()$t("Escolha o indicador de acessibilidade"), + tooltip_id = "q1" + ), choices = vector_indicadores, selected = "CMA"), div( @@ -141,8 +143,10 @@ output$page_content <- renderUI({ conditionalPanel(condition = "input.indicador == 'CMA'", pickerInput(inputId = "atividade_cum", - label = label_with_info(label = i18n()$t("Escolha a atividade"), - tooltip_id = "q3"), + label = label_with_info( + label = i18n()$t("Escolha a atividade"), + tooltip_id = "q3" + ), choices = c(list_trabalho, list_saude, list_edu), selected = "TT")), @@ -150,8 +154,10 @@ output$page_content <- renderUI({ conditionalPanel(condition = "input.indicador == 'TMI'", pickerInput(inputId = "atividade_min", - label = label_with_info(label = i18n()$t("Escolha a atividade"), - tooltip_id = "q4"), + label = label_with_info( + label = i18n()$t("Escolha a atividade"), + tooltip_id = "q4" + ), choices = c(list_saude, list_edu), selected = "ST")), div( diff --git a/atlasacessibilidade/server.R b/atlasacessibilidade/server.R index 0fdc6c4..ea01aa2 100755 --- a/atlasacessibilidade/server.R +++ b/atlasacessibilidade/server.R @@ -21,7 +21,6 @@ function(input, output, session) { # 2) MODAL WITH LANGUAGE OPTION AT STARTUP ---------------------------------------------------------- query_modal <- div(id = "modal_lang", modalDialog( - # title = HTML("

Instruções para uso do mapa interativo na aba ao lado  

"), title = HTML("

Lingua // Language

"), renderUI({ div(style = "width: 50%;margin: 0 auto;", @@ -31,20 +30,13 @@ function(input, output, session) { choicesOpt = list(content = (c("

  Português

", "

   English

"))), selected = input$selected_language), - - # actionButton(inputId = "openDetails", - # label = "", - # icon = icon("check")) ) }), - - # includeHTML("www/carousel_2.html"), easyClose = TRUE, size = "m", footer = div(id = "openDetails", class = "btn btn-default action-button shiny-bound-input", tagList( modalButton(icon("check")) - # actionButton(inputId = "openDetails", label = "", icon = icon("check")) ) ) @@ -54,22 +46,8 @@ function(input, output, session) { # Show the model on start up ... showModal(query_modal) - - # 3) OBSERVER TO TIMEOUT IF USER IS INACTIVE (inactive) ----------------------------------------------------- - - # observeEvent(input$timeOut, { - # print(paste0("Session (", session$token, ") timed out at: ", Sys.time())) - # showModal(modalDialog( - # title = "Timeout", - # HTML(paste("Session timeout due to", input$timeOut, "inactivity -", Sys.time()), "
"), - # HTML("Recarregar"), - # footer = NULL - # )) - # session$close() - # }) - -# RENDER LANDING PAGE ------------------------------------------------------------------------- + # 3) RENDER LANDING PAGE ------------------------------------------------------------------------- observeEvent(input$openDetails, { @@ -89,34 +67,9 @@ function(input, output, session) { }) - # Second modal with instrctions - observeEvent({input$tabs == "tab_mapa"}, once = TRUE, { - - if (input$tabs == "tab_mapa") { - - showModal( - div(class = "modal_instructions", - modalDialog( - # title = "Teste", - HTML(sprintf("

%s  

", i18n()$t("Comece selecionando uma cidade"))), - easyClose = TRUE, - size = "s", - footer = NULL - - )) - ) - - } - - - }) - - - # 3) RENDER 'UI' HERE SO IT CAN UPDATE FOR THE LANGUAGUES --------------------------------------------- - - # 3.1 Reactive to select the translator for the active langague ------------- + # 4) Reactive to select the translator for the active langague ------------- i18n <- reactive({ selected <- input$selected_language if (length(selected) > 0 && selected %in% translator$languages) { @@ -127,7 +80,7 @@ function(input, output, session) { - # TRANSLATE TAB TITLES ------------------------------------------------------------------------ + # 5) TRANSLATE TAB TITLES ------------------------------------------------------------------------ output$title_map = renderText({ switch(input$selected_language, "pt"="Mapa", "en"="Map") @@ -138,916 +91,23 @@ function(input, output, session) { }) - # 3.2 Start of the UI (map) ------------------------------------- - source("modules/map_ui.R", local = TRUE) - - - # 3.2 Start of the UI (graphs) ------------------------------------- + # 6) UI: GRAPHS ---------------------------------------------------------------------------------- source("modules/graphs_ui.R", local = TRUE) - - # 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)")) - - }) - - # SERVER-GRAPHS ------------------------------------------------------------------------------- - - - # # Reative para indicador - # indicador_filtrado_graph <- reactive({ - # - # palma[indicador == input$indicador_graph] - # - # }) - # - - # Reactive para a modo - modo_filtrado_graph <- reactive({ - - - if (input$graph_type == "palma_renda") { - - aa <- palma_renda[modo == input$modo_todos_graph] - - } else if (input$graph_type == "palma_cor") { - - aa <- palma_cor[modo == input$modo_todos_graph] - - } else if (input$graph_type == "dumbell_renda") { - - aa <- dumbell_renda[modo == input$modo_todos_graph] - - } else if (input$graph_type == "dumbell_cor") { - - aa <- dumbell_cor[modo == input$modo_todos_graph] - - } - - }) - - # Reative to activity - # Reative to time threshold - input_atividade_graph <- reactive({ - - if(input$graph_type %in% c("palma_renda", "palma_cor")) {input$atividade_graph_cum} else {input$atividade_graph_tmi} - - }) - - - atividade_filtrada_graph <- reactive({ - - bb <- modo_filtrado_graph()[atividade == input_atividade_graph()] - # bb <- filter(modo_filtrado_graph(), atividade == input$atividade_cum_graph) - - # print(input$atividade_cum_graph) - # print(input$atividade_cum_graph) - - # return(bb) - - print(paste0("aaa", nrow(bb))) - - return(bb) - - }) - - # Reative to time threshold - input_tempo_graph <- reactive({ - - if(input$modo_todos_graph %in% c("caminhada", "bicicleta")) {input$tempo_ativo_graph} else {input$tempo_tp_graph} - - }) - - tempo_filtrado_graph <- reactive({ - - cc <- atividade_filtrada_graph()[tempo_viagem == input_tempo_graph()] - # cc <- filter(atividade_filtrada_graph(), tempo_viagem == input_tempo_graph()) - - # print(input_tempo_graph()) - - # print(nrow(cc)) - # print(ncol(cc)) - - # return(cc) - - }) - -make_title_plots <- reactive({ - - # make title plot - title_plot_graph <- switch(input$graph_type, - "palma_renda" = i18n()$t("Desigualdade por renda"), - "palma_cor" = i18n()$t("Desigualdade por cor"), - "dumbell_renda" = i18n()$t("Desigualdade por renda"), - "dumbell_cor" = i18n()$t("Desigualdade por cor")) - - title_plot_modo <- switch(input$modo_todos_graph, - "tp" = i18n()$t("por transporte público"), - "caminhada" = i18n()$t("por caminhada"), - "bicicleta" = i18n()$t("por bicicleta")) - - title_plot_atividade <- switch(input_atividade_graph(), - "TT" = switch(input$graph_type, - "palma_renda" = i18n()$t("para trabalho"), - "palma_cor" = i18n()$t("para trabalho"), - "dumbell_renda" = "vazio", - "dumbell_cor" = "vazio"), - "ET" = switch(input$graph_type, - "palma_renda" = i18n()$t("para educação"), - "palma_cor" = i18n()$t("para educação"), - "dumbell_renda" = i18n()$t("à escola mais próxima"), - "dumbell_cor" = i18n()$t("à escola mais próxima")), - "EI" = switch(input$graph_type, - "palma_renda" = i18n()$t("para educação infantil"), - "palma_cor" = i18n()$t("para educação infantil"), - "dumbell_renda" = i18n()$t("à escola infantil mais próxima"), - "dumbell_cor" = i18n()$t("à escola infantil mais próxima")), - "EF" = switch(input$graph_type, - "palma_renda" = i18n()$t("para educação fundamental"), - "palma_cor" = i18n()$t("para educação fundamental"), - "dumbell_renda" = i18n()$t("à escola fundamental mais próxima"), - "dumbell_cor" = i18n()$t("à escola fundamental mais próxima")), - "EM" = switch(input$graph_type, - "palma_renda" = i18n()$t("para educação média"), - "palma_cor" = i18n()$t("para educação média"), - "dumbell_renda" = i18n()$t("à escola média mais próxima"), - "dumbell_cor" = i18n()$t("à escola média mais próxima")), - "ST" = switch(input$graph_type, - "palma_renda" = i18n()$t("para saúde"), - "palma_cor" = i18n()$t("para saúde"), - "dumbell_renda" = i18n()$t("ao equipamento de saúde mais próximo"), - "dumbell_cor" = i18n()$t("ao equipamento de saúde mais próximo")), - "SB" = switch(input$graph_type, - "palma_renda" = i18n()$t("para saúde baixa"), - "palma_cor" = i18n()$t("para saúde baixa"), - "dumbell_renda" = i18n()$t("ao equipamento de saúde baixo mais próximo"), - "dumbell_cor" = i18n()$t("ao equipamento de saúde baixo mais próximo")), - "SM" = switch(input$graph_type, - "palma_renda" = i18n()$t("para saúde média"), - "palma_cor" = i18n()$t("para saúde média"), - "dumbell_renda" = i18n()$t("ao equipamento de saúde médio mais próximo"), - "dumbell_cor" = i18n()$t("ao equipamento de saúde médio mais próximo")), - "SA" = switch(input$graph_type, - "palma_renda" = i18n()$t("para saúde alta"), - "palma_cor" = i18n()$t("para saúde alta"), - "dumbell_renda" = i18n()$t("ao equipamento de saúde alta mais próximo"), - "dumbell_cor" = i18n()$t("ao equipamento de saúde alta mais próximo"))) - - title_plot_df <- data.frame(graph = title_plot_graph, - modo = title_plot_modo, - atividade = title_plot_atividade) - - print(title_plot_df$graph) - print(title_plot_df$modo) - print(title_plot_df$atividade) - - return(title_plot_df) - + # 7) UI: MAP ------------------------------------------------------------------------------------- + source("modules/map_ui.R", local = TRUE) -}) + # 8) DOWNLOAD BUTTON ----------------------------------------------------------------------------- + source("modules/download_button.R", local = TRUE) + # 9) SERVER: GRAPHS ------------------------------------------------------------------------------ + source("modules/graphs_server.R", local = TRUE) - # Render graphs - output$output_graph <- renderHighchart({ - - - # GRAPH FOR PALMA RATIO - if (input$graph_type %in% c("palma_renda", "palma_cor")) { - - new <- tempo_filtrado_graph() %>% - # mutate(sigla_muni = factor(sigla_muni, levels = munis_df$abrev_muni, labels = munis_df$name_muni)) %>% - mutate(nome_muni = factor(nome_muni)) - # mutate(sigla_muni = forcats::fct_reorder(sigla_muni, palma_ratio)) - - new <- arrange(new, desc(palma_ratio)) - - - 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")) - - print(title_plot) - print(legend_plot) - - - hchart(new, "bar", hcaes(x = nome_muni, y = palma_ratio), - name = "Palma Ratio") %>% - hc_title(text = title_plot, - align = "left", x = 50) %>% - hc_subtitle(text = legend_plot, - align = "left", x = 50) %>% - hc_xAxis(opposite = FALSE, - title = list(text = "") - , labels = list( - # format = "{value}%", - style = list(fontSize = 15)) - ) %>% - hc_yAxis(title = list(text = ifelse(input$graph_type == "palma_renda", - i18n()$t("Razão de Palma"), - i18n()$t("Razão de Desigualdade por Cor")))) %>% - # change bar colors - hc_colors(colors = "#1D5A79") %>% - # change font - hc_chart(style = list(fontFamily = "Roboto Condensed")) %>% - # add vertical line - hc_yAxis(plotLines = list(list(color = "#99A3A4", value = 1, width = 2, zIndex = 5, dashStyle = "LongDash"))) %>% - hc_exporting(enabled = FALSE) %>% - # add data label at the end of each bar (with values) - hc_plotOptions(bar = list(dataLabels = list(enabled = TRUE, - align = "right", - x = -5, - style = list(fontSize = 15, - color = "white", - textOutline = "0.3px white", - fontWeight = "regular")))) - - } 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")) - - - # arrange by Q1 - - teste_dumbell <- arrange(atividade_filtrada_graph(), -low) - - highchart() %>% - hc_xAxis(categories = teste_dumbell$nome_muni, labels = list(style = list(fontSize = 15))) %>% - hc_yAxis(min = 0, labels = list(style = list(fontSize = 15)), title = list(text = i18n()$t("Minutos"))) %>% - hc_chart(inverted = TRUE) %>% - hc_title(text = title_plot, - align = "left", x = 25) %>% - # change font - hc_chart(style = list(fontFamily = "Roboto Condensed")) %>% - hc_subtitle(text = legend_plot, - align = "left", x = 25) %>% - hc_legend(itemStyle = list(fontSize = 15)) %>% - # add bar - hc_add_series(data = teste_dumbell, - type = "errorbar", - color = "#95A5A6", - lineWidth = 5, - opacity = 0.5, - name = "", - tooltip = list(enabled = TRUE, - valueDecimals = 0), - whiskerWidth = 0) %>% - # add total - hc_add_series(data = teste_dumbell$total, - type = "scatter", - color = "black", - name = "Total", - size = 5, - marker = list(radius = 7), - tooltip = list(pointFormat = sprintf("%s: {point.y}", i18n()$t("Valor")), - valueDecimals = 0)) %>% - # add Q1 - hc_add_series(data = teste_dumbell$low, - type = "scatter", - color = "#008B45", - name = ifelse(input$graph_type == "dumbell_renda", i18n()$t("Pobres Q1"), i18n()$t("Negros")), - marker = list(radius = 7, symbol = "circle"), - tooltip = list(pointFormat = sprintf("%s: {point.y}", i18n()$t("Valor")), - valueDecimals = 0)) %>% - # add Q5 - hc_add_series(data = teste_dumbell$high, - type = "scatter", - color = "#36648B", - name = ifelse(input$graph_type == "dumbell_renda", i18n()$t("Ricos Q5"), i18n()$t("Brancos")), - marker = list(radius = 7, symbol = "circle"), - tooltip = list(pointFormat = sprintf("%s: {point.y}", i18n()$t("Valor")), - valueDecimals = 0)) - - - } - - - }) - - # 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) - - }) + # 10) SERVER: MAP -------------------------------------------------------------------------------- + source("modules/map_server.R", local = TRUE) + - # DOWNLOAD BUTTON ----------------------------------------------------------------------------- - - # 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")) { - - file_name <- 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)+ - # geom_point(aes(x = total, y = nome_muni), color = "black", 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") - - } - ) - - - - - # 4) REACTIVE TO FILTER THE CITY ----------------------------------------------------------------- - a_city <- reactive({ - - if(input$cidade != "") {input$cidade} else {"fake"} - - - }) - - cidade_filtrada <- reactive({ - - acess[sigla_muni == a_city()] - - }) - - - - # 5) REACTIVE TO FILTER THE MODE ----------------------------------------------------------------- - a <- reactive({ - - if (a_city() %in% c('for', 'spo', 'rio', 'cur', 'poa', 'bho', 'rec')) {input$modo_todos} - - else if(a_city() %in% c('bsb', 'sal', 'man', 'goi', 'bel', 'gua', 'cam', 'slz', 'sgo', 'mac', 'duq', 'cgr', 'nat', 'fake')) { - - # # Reactive para a modo para indicador cumulativo - input$modo_ativo } - - }) - - # Reactive para a modo - modo_filtrado <- reactive({ - - cidade_filtrada()[modo == a()] - - }) - - # 6) REACTIVE TO FILTER THE INDICATOR ------------------------------------------------------------ - indicador_filtrado <- reactive({ - - modo_filtrado() %>% dplyr::select(id_hex, P001, matches(input$indicador)) - - }) - - - # 7) REACTIVE TO FILTER THE ACTIVITY ------------------------------------------------------------ - # Reactive para a atividade para indicador cumulativo - atividade_filtrada <- reactive({ - - indicador_filtrado() %>% dplyr::select(id_hex, P001, matches(input$atividade_cum)) - - }) - - - # # Reactive para a atividade para indicador cumulativo - atividade_filtrada_min <- reactive({ - - indicador_filtrado() %>% dplyr::select(id_hex, P001, matches(input$atividade_min)) %>% - rename(id_hex = 1, P001 = 2, valor = 3) %>% - mutate(id = 1:n()) %>% - mutate(popup = paste0(i18n()$t("População: "), P001, i18n()$t("
Valor da acessibilidade: "), round(valor, 0), " ", i18n()$t("minutos"))) - - }) - - atividade_filtrada_min_sf <- reactive({ - - atividade_filtrada_min() %>% setDT() %>% - merge(hex, by = "id_hex", all.x = TRUE, sort = FALSE) %>% - st_sf(crs = 4326) - - }) - - # 8) REACTIVE TO FILTER THE TIME THRESHOLD ------------------------------------------------------- - b <- reactive({ - - if (a_city() %in% c('for', 'spo', 'rio', 'cur', 'poa', 'bho', 'rec') & input$modo_todos %in% "tp") {input$tempo_tp} - - else if (a_city() %in% c('for', 'spo', 'rio', 'cur', 'poa', 'bho', 'rec') & input$modo_todos %in% c("caminhada", "bicicleta")) {input$tempo_ativo_tp} - - else if (a_city() %in% c('bsb', 'sal', 'man', 'goi', 'bel', 'gua', 'cam', 'slz', 'sgo', 'mac', 'duq', 'cgr', 'nat', 'fake')) {input$tempo_ativo} - - }) - - # Reactive para o tempo - tempo_filtrado <- reactive({ - - atividade_filtrada() %>% dplyr::select(id_hex, P001, matches(as.character(b()))) %>% - rename(id_hex = 1, P001 = 2, valor = 3) %>% - mutate(id = 1:n()) %>% - # create popup - mutate(popup = paste0(i18n()$t("População: "), P001, i18n()$t("
Valor da acessibilidade: "), round(valor, 1), "%")) - - # print(unique(time1$modo)) - - # print(nrow(time1)) - - # return(time1) - - }) - - # Reactive para o tempo - tempo_filtrado_sf <- reactive({ - - tempo_filtrado() %>% setDT() %>% - merge(hex, by = "id_hex", all.x = TRUE, sort = FALSE) %>% - st_sf(crs = 4326) - - - }) - - - - - # 9) RENDER BASEMAP ------------------------------------------------------- - # baseMap - output$map <- renderMapdeck({ - - mapdeck(location = c(-43.95988, -19.902739), zoom = 3) - - - }) - - - # Stop the loading page here ! - waiter_hide() - - - # 10) OBSERVER TO RENDER THE CITY INDICATOR ------------------------------------------------------- - observeEvent({input$cidade},{ - - - # Filtrar limites - limits_filtrado <- filter(limits, abrev_muni == input$cidade) - - if (input$cidade != "") { - - centroid_go <- filter(centroids, abrev_muni == input$cidade) - - if(input$cidade %in% c("spo", "man", "cgr", "bsb")) { - - zoom1 <- 9 - - } else if(input$cidade %in% c("mac", "for", "nat", "rec", "sal", "slz", "bho")) { - - zoom1 <- 11 - - } else {zoom1 <- 10} - - # if(input$indicador == "CMA") { - # - # data1 <- tempo_filtrado() - # layer_id1 <- "acess_cum_go" - # palette1 <- "inferno" - # legend_options1 <- list(title = "Porcentagem de Oportunidades Acessíveis") - # - # } else if (input$indicador == "TMI") { - # - # data1 <- atividade_filtrada_min - # layer_id1 <- "acess_min_go" - # palette1 <- "inferno" - # legend_options1 <- list(title = "Porcentagem de Oportunidades Acessíveis") - # - # - # } - - proxy <- mapdeck_update(map_id = "map") %>% - mapdeck_view(location = c(centroid_go$lon, centroid_go$lat), zoom = zoom1, - duration = 3000, transition = "fly") - - if (input$indicador == "CMA") { - - proxy %>% - clear_polygon(layer_id = "acess_min_go") %>% - clear_legend(layer_id = "acess_min_go") %>% - add_polygon( - data = limits_filtrado, - stroke_colour = "#616A6B", - stroke_width = 100, - fill_opacity = 0, - update_view = FALSE, - focus_layer = FALSE, - ) %>% - add_polygon( - data = tempo_filtrado_sf(), - fill_colour = "valor", - fill_opacity = 200, - layer_id = "acess_cum_go", - palette = "inferno", - update_view = FALSE, - focus_layer = FALSE, - # auto_highlight = TRUE, - tooltip = "popup", - legend = TRUE, - legend_options = list(title = i18n()$t("Porcentagem de Oportunidades Acessíveis")), - legend_format = list( fill_colour = as.integer) - ) - - - } else if (input$indicador == "TMI") { - - # create viridis scale in the reverse direction - # create matrix - colorss <- colourvalues::color_values_rgb(x = 1:256, "viridis") - # invert matrix - colorss <- apply(colorss, 2, rev)[, 1:3] - - proxy %>% - clear_polygon(layer_id = "acess_cum_go") %>% - clear_legend(layer_id = "acess_cum_go") %>% - add_polygon( - data = limits_filtrado, - stroke_colour = "#616A6B", - stroke_width = 100, - fill_opacity = 0, - update_view = FALSE, - focus_layer = FALSE - ) %>% - add_polygon( - data = atividade_filtrada_min_sf(), - fill_colour = "valor", - fill_opacity = 200, - layer_id = "acess_min_go", - palette = colorss, - update_view = FALSE, - tooltip = "popup", - legend = TRUE, - legend_options = list(title = i18n()$t("Minutos até a oportunidade mais próxima")), - legend_format = list( fill_colour = as.integer) - ) - - } - - - } - - - - }) - - - observeEvent({c(input$indicador, - input$modo_todos, input$modo_ativo, - input$atividade_cum, input$atividade_min, - input$tempo_tp, input$tempo_ativo_tp, input$tempo_ativo)},{ - - - if (a_city() != "fake") { - - - if (input$indicador == "TMI") { - - # create viridis scale in the reverse direction - # create matrix - colorss <- colourvalues::color_values_rgb(x = 1:256, "viridis") - # invert matrix - colorss <- apply(colorss, 2, rev)[, 1:3] - - mapdeck_update(map_id = "map") %>% - clear_polygon(layer_id = "acess_cum_go") %>% - clear_legend(layer_id = "acess_cum_go") %>% - add_polygon( - data = atividade_filtrada_min_sf(), - fill_colour = "valor", - fill_opacity = 200, - layer_id = "acess_min_go", - palette = colorss, - update_view = FALSE, - tooltip = "popup", - legend = TRUE, - legend_options = list(title = i18n()$t("Minutos até a oportunidade mais próxima")), - legend_format = list( fill_colour = as.integer) - ) - - } else - - if (input$indicador == "CMA") { - - mapdeck_update(map_id = "map") %>% - clear_polygon(layer_id = "acess_min_go") %>% - clear_legend(layer_id = "acess_min_go") %>% - add_polygon( - data = tempo_filtrado_sf(), - fill_colour = "valor", - fill_opacity = 200, - layer_id = "acess_cum_go", - palette = "inferno", - update_view = FALSE, - focus_layer = FALSE, - # auto_highlight = TRUE, - tooltip = "popup", - legend = TRUE, - legend_options = list(title = i18n()$t("Porcentagem de Oportunidades Acessíveis")), - legend_format = list( fill_colour = as.integer) - ) - } - - - } - }) - - - # fim <- reactive({ - # - # if(input$indicador == "CMA") {df <- tempo_filtrado() %>% setDT()} - # else if (input$indicadot == "TMI") {df <- atividade_filtrada_min() %>% setDT()} - # - # }) - # - # - # - # fim_v1 <- reactive({ - # - # city_pop <- sum(fim()$P001) - # - # fim_ordered <- setorder(fim(), valor, P001) - # - # fim_ordered_cum <- fim_ordered[, cumsum := cumsum(P001)/city_pop] - # - # }) - # - # - # - # - # global <- reactiveValues() - # - # - # # produce plot for the whole city when we change cities - # output$plot <- renderPlotly({ - # - # if(input$cidade == "") {return()} else { - # - # # go <- ggplot(fim_v1())+ - # # geom_bar(aes(x = quebra, y = N, fill = global$high), stat = "identity")+ - # # scale_fill_manual(values = c("yes"="tomato", "no"="gray" ), guide = FALSE )+ - # # theme_minimal()+ - # # labs(x = "", y = "")+ - # # theme(plot.margin = unit(c(0,0,0,0), "cm"), - # # rect = element_rect(fill = "transparent")) - # # - # # ui <- ggplotly(go) - # # - # # print(ui) - # # - # # return(ui) - # - # - # plotly_go <- plot_ly(fim_v1(), x = ~cumsum, y = ~valor, type = 'scatter', mode = 'lines') %>% - # layout(title = "Indicador Cumulativo", - # xaxis = list(title = "% populacao"), - # yaxis = list(title = "% oportunidades")) - # - # return(plotly_go) - # - # - # } - # - # } - # ) - # - # - # # observer to update only the highlighted bar on MAP CLICK - # observeEvent({input$map_polygon_click},{ - # # print( input$map_polygon_click ) - # - # js <- input$map_polygon_click - # lst <- jsonlite::fromJSON( js ) - # row <- (lst$index) + 1 - # - # - # # get problematic value of hist - # valor_prob <- fim_v1()[id == row]$valor - # cumsum_prob <- fim_v1()[id == row]$cumsum - # - # - # # pegar quebra - # - # print(valor_prob) - # print(cumsum_prob) - # - # - # plotlyProxy("plot") %>% - # plotlyProxyInvoke("deleteTraces", list(as.integer(1))) %>% - # plotlyProxyInvoke("addTraces", list(x=c(cumsum_prob, cumsum_prob), - # y=c(valor_prob, valor_prob))) - # # marker = list(size = 10, - # # color = 'rgba(255, 182, 193, .9)', - # # line = list(color = 'rgba(152, 0, 0, .8)', - # # width = 2))) - # # plotlyProxyInvoke("addTraces", list(x=c(as.factor(quebra_prob), as.factor(quebra_prob)), - # # y=c(as.factor(valor_prob), as.factor(valor_prob)), - # # type = 'bar', - # # marker = list(color = 'rgb(211,84,0)', - # # line = list(color = 'rgb(8,48,107)', - # # width = 1.5)))) - # - # }) - - } \ No newline at end of file diff --git a/atlasacessibilidade/ui.R b/atlasacessibilidade/ui.R index c96debd..2e2b037 100755 --- a/atlasacessibilidade/ui.R +++ b/atlasacessibilidade/ui.R @@ -13,7 +13,6 @@ shinyUI( tags$head(tags$script("var modos_ativos = ['caminhada', 'bicicleta'];")), tags$head(tags$script("var graphs_cma = ['palma_renda', 'palma_cor'];")), tags$head(tags$script("var graphs_tmi = ['dumbell_renda', 'dumbell_cor'];")), - tags$script(inactivity), # Select custom slider # https://divadnojnarg.github.io/blog/customsliderinput/ chooseSliderSkin("HTML5", color = "#112446") @@ -27,7 +26,8 @@ shinyUI( # Output map mapdeckOutput("map"), # Create the main absolute panel - absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE, draggable = FALSE, + absolutePanel(id = "controls", class = "panel panel-default", + fixed = TRUE, draggable = FALSE, top = 80, right = 20, width = 350, height = 615, # Output the 'UI' that was generated in the server uiOutput('page_content') @@ -35,12 +35,14 @@ shinyUI( ), tabPanel(id = "tab_graphs", title = uiOutput('title_graph'), - absolutePanel(id = "controls_graphs", class = "panel panel-default", fixed = TRUE, draggable = FALSE, + absolutePanel(id = "controls_graphs", class = "panel panel-default", + fixed = TRUE, draggable = FALSE, top = 80, right = 20, width = 420, height = 615, uiOutput('graphs') ), # panel to but download button - absolutePanel(id = "download_panel", class = "panel panel-default", fixed = TRUE, draggable = FALSE, + absolutePanel(id = "download_panel", class = "panel panel-default", + fixed = TRUE, draggable = FALSE, top = 80, right = 380, width = 200, height = 100, dropdownButton( uiOutput('ui_download_button'), @@ -56,15 +58,14 @@ shinyUI( inputId = "download_dropdown" )), - absolutePanel(id = "controls_graphs1", class = "panel panel-default", fixed = TRUE, draggable = FALSE, + absolutePanel(id = "controls_graphs1", class = "panel panel-default", + fixed = TRUE, draggable = FALSE, top = 80, left = 80, height = "100%", highchartOutput('output_graph', height = "90%") ) - # ) ) - # ) ) )