Global Health & Prosperity Dashboard (Gapminder)

library(flexdashboard)
library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   4.0.0     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.1.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(gapminder)
library(plotly)


Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

library(DT)
library(countrycode)
library(scales)


Attaching package: 'scales'

The following object is masked from 'package:purrr':

    discard

The following object is masked from 'package:readr':

    col_factor

library(shiny)


Attaching package: 'shiny'

The following objects are masked from 'package:DT':

    dataTableOutput, renderDataTable

gm <- gapminder %>%
mutate(
iso3c = countrycode(country, origin = 'country.name', destination = 'iso3c'),
income_group = case_when(
gdpPercap < quantile(gdpPercap, 0.25, na.rm = TRUE) ~ 'Low',
gdpPercap < quantile(gdpPercap, 0.50, na.rm = TRUE) ~ 'Lower-Middle',
gdpPercap < quantile(gdpPercap, 0.75, na.rm = TRUE) ~ 'Upper-Middle',
TRUE ~ 'High'
)
)

years <- sort(unique(gm$year))
continents <- sort(unique(gm$continent))
countries <- sort(unique(gm$country))

year_selected <- reactiveVal(max(years))

inputPanel(
sliderInput("year", "Year:", min(years), max(years), value = max(years),
step = 5, sep = ""),
selectizeInput("continents", "Continents:",
choices = continents, selected = continents,
multiple = TRUE),
selectizeInput("country_focus", "Highlight a country:",
choices = countries, selected = "United States",
multiple = FALSE)
)

Year:

Continents:

Highlight a country:

observeEvent(input$year, { year_selected(input$year) })

data_current <- reactive({
gm %>% filter(year == input$year, continent %in% input$continents)
})

renderPlotly({
df <- data_current()
p <- ggplot(
df,
aes(
x = gdpPercap, y = lifeExp, size = pop, color = continent,
text = paste0(
"", country, "",
"Continent: ", continent, "",
"Life Expectancy: ", round(lifeExp, 1), "",
"GDP per Capita: ", dollar(round(gdpPercap, 0)), "",
"Population: ", comma(pop)
)
)
) +
geom_point(alpha = 0.7) +
scale_x_log10(labels = dollar_format()) +
scale_size(range = c(4, 20), guide = "none") +
labs(x = "GDP per Capita (log scale)",
y = "Life Expectancy (years)",
color = "Continent") +
theme_minimal(base_size = 12)

ggplotly(p, tooltip = "text") %>%
layout(legend = list(orientation = 'h', y = -0.2))
})

renderPlotly({
df <- data_current() %>% filter(!is.na(iso3c))
plot_ly(
df, type = 'choropleth',
locations = ~iso3c, locationmode = 'ISO-3',
z = ~lifeExp,
text = ~paste(country, "Life Exp:", round(lifeExp,1)),
colorscale = 'Viridis',
zmin = min(gm$lifeExp, na.rm = TRUE),
zmax = max(gm$lifeExp, na.rm = TRUE)
) %>%
colorbar(title = "Life Exp") %>%
layout(geo = list(showframe = FALSE, showcoastlines = TRUE))
})

renderPlotly({
df <- data_current() %>%
group_by(continent, income_group) %>%
summarize(pop = sum(pop, na.rm = TRUE), .groups = 'drop') %>%
mutate(income_group = factor(income_group, levels = c('Low','Lower-Middle','Upper-Middle','High')))

p <- ggplot(
df,
aes(
x = continent, y = pop, fill = income_group,
text = paste0(
"Continent: ", continent,
"Income Group: ", income_group,
"Population: ", comma(pop)
)
)
) +
geom_col() +
labs(x = "Continent", y = "Population", fill = "Income Group") +
scale_y_continuous(labels = comma) +
theme_minimal(base_size = 12)

ggplotly(p, tooltip = "text")
})

renderPlotly({
  df <- data_current()
  p <- ggplot(df, aes(...)) + geom_point(...)
  ggplotly(p)
})

renderPlotly({
df <- gm %>% filter(continent %in% input$continents)
focus <- input$country_focus

p <- ggplot(
df,
aes(x = year, y = lifeExp, group = country, color = continent,
alpha = if_else(country == focus, 1, 0.2),
linewidth = if_else(country == focus, 1.2, 0.2))
) +
geom_line() +
scale_alpha_identity() + scale_linewidth_identity() +
labs(x = "Year", y = "Life Expectancy (years)", color = "Continent") +
theme_minimal(base_size = 12)

ggplotly(p)
})

renderDataTable({
data_current() %>%
select(country, continent, year, lifeExp, gdpPercap, pop, income_group) %>%
datatable(options = list(pageLength = 10, scrollX = TRUE))
})

`shiny::renderDataTable()` is deprecated as of shiny 1.8.1.
Please use `DT::renderDT()` instead.
Since you have a suitable version of DT (>= v0.32.1), shiny::renderDataTable() will automatically use DT::renderDT() under-the-hood.
If this happens to break your app, set `options(shiny.legacy.datatable = TRUE)` to get the legacy datatable implementation (or `FALSE` to squelch this message).
See <https://rstudio.github.io/DT/shiny.html> for more information.