Skip to content

Commit

Permalink
Merge pull request #59 from worldbank/issue-57
Browse files Browse the repository at this point in the history 
trends tab
  • Loading branch information
@luizaandrade
luizaandrade authored Nov 8, 2021
2 parents 5e57f45 + 81c3f7e commit a05b05d
Show file tree
Hide file tree
Showing 3 changed files with 137 additions and 68 deletions.
2 changes: 0 additions & 2 deletions app/auxiliary/plots.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,8 +110,6 @@ interactive_plot <-
width = 1100,
height = 1000)
)


}

interactive_map <-
Expand Down
146 changes: 95 additions & 51 deletions app/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@
library(sf)
library(hrbrthemes)
library(stringr)
library(grDevices)


# Inputs ################################################################################
Expand Down Expand Up @@ -77,6 +78,7 @@
read_rds(file.path("data",
"wb_country_list.rds"))

color_groups <- colorRampPalette(c("#053E5D", "#60C2F7"))


# Server ################################################################################
Expand Down Expand Up @@ -286,7 +288,7 @@
na.value = "#808080",
drop=F) +
labs(title = paste0("<b>",input$vars_map,"</b>")) +
theme_bw()
theme_ipsum()

interactive_map(map, input$vars_map)
}
Expand All @@ -295,62 +297,105 @@

# Trends =====================================================================================

observeEvent(input$indicator_trends,
{
var_selected <-
variable_names %>%
filter(var_name %in% input$indicator_trends) %>%
.$variable
var_trends <-
eventReactive(input$indicator_trends,
{
var_selected <-
variable_names %>%
filter(var_name == input$indicator_trends) %>%
.$variable
}
)

data <-
raw_data %>%
filter(
country_name == input$country_trends
) %>%
select(country_name, Year, all_of(var_selected)) %>%
pivot_longer(cols = all_of(var_selected),
names_to = "variable",
values_to = "Indicator value") %>%
left_join(variable_names) %>%
rename(Country = country_name,
`Indicator name` = var_name) %>%
mutate(across(where(is.numeric),
round, 3))

output$time_series <-
renderPlotly({
data_trends <-
reactive({

data <-
raw_data %>%
filter(country_name %in% c(input$country_trends)) %>%
mutate(alpha = .8,
shape = 19)

if (!is.null(input$countries_trends)) {

data <-
raw_data %>%
filter(country_name %in% c(input$countries_trends)) %>%
mutate(alpha = .5,
shape = 18) %>%
bind_rows(data)
}

if (!is.null(input$group_trends)) {

indicator <-
raw_data %>%
select(country_name, Year, all_of(var_trends()))

data <-
country_list %>%
filter(group %in% input$group_trends) %>%
select(group, country_name) %>%
mutate(country_name = as.character(country_name)) %>%
left_join(indicator) %>%
group_by(Year, group) %>%
summarise_all(~ mean(., na.rm = TRUE)) %>%
mutate(country_name = as.character(group),
alpha = .5,
shape = 19) %>%
bind_rows(data)
}

data %>%
rename(Country = country_name) %>%
select(Country, Year, all_of(var_trends()), alpha) %>%
mutate_at(vars(all_of(var_trends())),
~ round(., 3))
})

output$time_series <-
renderPlotly({

if (input$indicator_trends != "") {
static_plot <-
ggplot(data %>% group_by(variable),
aes(x = Year,
y = `Indicator value`,
color = `Indicator name`)) +
geom_point(size = 3,
alpha = .5) +
geom_line(lwd = 1.5,
alpha = .5) +
ggplot(data_trends(),
aes_string(x = "Year",
y = var_trends(),
color = "Country",
alpha = "alpha")) +
geom_point(aes(text = paste("Country:", Country, "<br>",
"Year:", Year, "<br>",
"Value:", get(var_trends()))),
size = 3) +
geom_line() +
theme_ipsum() +
labs(
x = "Year",
y = "Indicator value"
y = "Indicator value",
title = paste0("<b>",input$indicator_trends,"</b>")
) +
scale_color_discrete(name = "Indicator name") +
theme(
axis.text.x = element_text(angle = 90, size=9, hjust = 0.5)
)
scale_color_manual(
name = NULL,
values = c("#FB8500",
gray.colors(length(input$countries_trends)),
color_groups(length(input$group_trends))),
breaks = c(input$country_trends,
input$countries_trends,
input$group_trends)
) +
scale_alpha_identity()

ggplotly(static_plot) %>%
ggplotly(static_plot, tooltip = "text") %>%
layout(
margin = list(l=50, r=50, t=75, b=135),
annotations =
list(x = 0, y = -0.3,
text = map(paste0("<b>Country: </b>",input$country_trends,"."), HTML),
showarrow = F,
xref = 'paper',
yref = 'paper',
align = 'left',
font = list(size = 12)
)
legend = list(
title=list(text='<b>Country:</b>'),
#orientation="h",
#yanchor="bottom",
y=0.5
#xanchor="right",
#x=1
),
margin = list(l=50, r=50, t=75, b=135)
) %>%
config(
modeBarButtonsToRemove = c("zoomIn2d",
Expand All @@ -367,10 +412,9 @@
tolower(input$country_trends),"_",
tolower(stringr::str_replace_all(input$indicator_trends,"\\s","_"))))
)
}

})

})
})

# Aggregation of preferences ================================================================================
observeEvent(input$select_pref,{
Expand Down
57 changes: 42 additions & 15 deletions app/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@

# Inputs ################################################################################

plot_height <- "500px"
plot_height <- "600px"

# Data sets ---------------------------------------------------------------------------

Expand Down Expand Up @@ -122,7 +122,7 @@ plot_height <- "500px"
sidebarLayout(
sidebarPanel(width = 3,
selectInput("country",
label = "Select a based country",
label = "Select a base country",
choices = c("", country_list$country_name %>% unique %>% sort),
selected = "Uruguay",
multiple = FALSE),
Expand Down Expand Up @@ -219,7 +219,7 @@ plot_height <- "500px"
sidebarPanel(width = 3,
pickerInput(
"vars_map",
label = NULL,
"Select an indicator",
choices = list(
#`Family level` = c(sort(names(definitions))),
`Anti-Corruption, Transparency and Accountability institutions` = c(variable_names %>% filter(var_level=="indicator" & family_var=="vars_fin") %>% .$var_name),
Expand All @@ -235,7 +235,7 @@ plot_height <- "500px"
options = list(
`live-search` = TRUE,
size = 25,
title = "Select indicator"
title = "Click to select family or indicator"
),
width = "100%"
)
Expand All @@ -244,7 +244,7 @@ plot_height <- "500px"
mainPanel(
width = 9,
plotlyOutput("map",
height = "600px")
height = plot_height)
)
)
)
Expand All @@ -259,15 +259,7 @@ plot_height <- "500px"

sidebarLayout(
sidebarPanel(width = 3,
selectInput(
"country_trends",
label = "Select a country",
choices = c("", country_list$country_name %>% unique %>% sort),
selected = "Uruguay",
multiple = FALSE
),

selectInput(
pickerInput(
"indicator_trends",
label = "Select the indicators",
multiple = TRUE,
Expand All @@ -282,12 +274,47 @@ plot_height <- "500px"
`Public sector institutions` = c(variable_names %>% filter(var_level=="indicator" & family_var=="vars_publ") %>% .$var_name),
`Social institutions` = c(variable_names %>% filter(var_level=="indicator" & family_var=="vars_social") %>% .$var_name)
),
width = "100%"
width = "100%",
options = list(
`live-search` = TRUE,
size = 25,
title = "Click to select"
)
),

selectInput("country_trends",
label = "Select a base country",
choices = c("", country_list$country_name %>% unique %>% sort),
selected = "Uruguay",
multiple = FALSE),

selectizeInput(
"group_trends",
label = "Select comparison groups",
choices = country_groups$group_name,
selected = "OECD members",
multiple = TRUE
),

HTML('<button id = "expand-button" class = "btn btn-default shiny-bound-input" data-toggle = "collapse" data-target = "#trends">Select comparison countries</button>'),
tags$div(id = 'trends',
class = "collapse",
style = "width: 1700px",
tags$div(
class = "multicol-7",
checkboxGroupInput(
"countries_trends",
label = NULL,
choices = country_list$country_name %>% unique %>% sort,
)
)
),

br(),br()
),

mainPanel(width = 8,
style = "z-index: -1",
tabPanel("Time Series",
plotlyOutput("time_series",
height = plot_height)
Expand Down

0 comments on commit a05b05d

Please sign in to comment.