# setwd("~/Downloads")
{
# app.R
options(error = NULL)
# ------------------------------
# 1. Load Packages
# ------------------------------
library(shiny)
library(shinydashboard)
library(leaflet)
library(raster)
library(DT)
library(readr)
library(dplyr) # For data manipulation
library(ggplot2) # For histogram
library(RColorBrewer)
library(sp) # For handling map clicks/extracting raster values
# ------------------------------
# 2. Data & Config
# ------------------------------
# Define time periods corresponding to each band in the GeoTIFF
time_periods <- c("1990–1992", "1993–1995", "1996–1998", "1999–2001", "2002–2004",
"2005–2007", "2008–2010", "2011–2013", "2014–2016", "2017–2019")
# Load GeoTIFF data (multi-band)
wealth_stack <- stack("wealth_map.tif")
# Clean up out-of-range values
wealth_stack[wealth_stack <= 0 | wealth_stack > 1] <- NA
all_vals <- values(wealth_stack)
all_vals <- all_vals[!is.na(all_vals)]
q_breaks_legend <- quantile(all_vals, probs = seq(0, 1, 0.2), na.rm = TRUE)
q_breaks <- quantile(all_vals, probs = seq(0, 1, 0.1), na.rm = TRUE)
# Load improvement data (change in IWI by state/province)
improvement_data <- read_csv("poverty_improvement_by_state.csv")
# Pre-calculate the mean IWI for each band (for the "Trends Over Time" chart).
band_means <- sapply(seq_len(nlayers(wealth_stack)), function(i) {
vals <- values(wealth_stack[[i]])
vals <- vals[!is.na(vals)]
mean(vals)
})
# ------------------------------
# 3. UI
# ------------------------------
ui <- dashboardPage(
# -- Header
dashboardHeader(
title = span(
style = "font-weight: 600; font-size: 16px;",
a(
href = "http://aidevlab.org",
"aidevlab.org",
target = "_blank",
style = "font-family: 'OCR A Std', monospace; color: white; text-decoration: underline;"
)
)
),
# -- Sidebar
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Wealth Map", tabName = "mapTab", icon = icon("map")),
menuItem("Improvement Data", tabName = "improvementTab", icon = icon("table")),
menuItem("Trends Over Time", tabName = "trendTab", icon = icon("chart-line"))
),
# Show inputs only for the map tab
conditionalPanel(
condition = "input.tabs == 'mapTab'",
br(),
# Replaces the old selectInput for time periods with a slider that can animate
sliderInput(
inputId = "time_index",
label = "Select Time Period (Years):",
min = 1,
max = length(time_periods),
value = 1,
step = 1,
animate = animationOptions(interval = 3000, loop = TRUE)
),
# Show the currently selected year range clearly
strong("Currently Selected: "),
textOutput("current_year_range", inline = TRUE),
br(), br(),
selectInput("color_palette", "Select Color Palette:",
choices = c("Viridis" = "viridis",
"Plasma" = "plasma",
"Magma" = "magma",
"Inferno"= "inferno",
"Spectral (Brewer)" = "Spectral"),
selected = "plasma"),
sliderInput("opacity", "Map Opacity:", min = 0.2, max = 1, value = 0.8, step = 0.1)
),
# ---- Here is the minimal "Share" button HTML + JS inlined in Shiny ----
# We wrap it in tags$div(...) and tags$script(HTML(...)) so it is recognized
# by Shiny. You can adjust the styling or placement as needed.
tags$div(
style = "text-align: left; margin: 1em 0 1em 2em;",
HTML('
'),
# Insert the JS as well
tags$script(
HTML("
(function() {
const shareBtn = document.getElementById('share-button');
// Reusable helper function to show a small “Copied!” message
function showCopyNotification() {
const notification = document.createElement('div');
notification.innerText = 'Copied to clipboard';
notification.style.position = 'fixed';
notification.style.bottom = '20px';
notification.style.right = '20px';
notification.style.backgroundColor = 'rgba(0, 0, 0, 0.8)';
notification.style.color = '#fff';
notification.style.padding = '8px 12px';
notification.style.borderRadius = '4px';
notification.style.zIndex = '9999';
document.body.appendChild(notification);
setTimeout(() => { notification.remove(); }, 2000);
}
shareBtn.addEventListener('click', function() {
const currentURL = window.location.href;
const pageTitle = document.title || 'Check this out!';
// If browser supports Web Share API
if (navigator.share) {
navigator.share({
title: pageTitle,
text: '',
url: currentURL
})
.catch((error) => {
console.log('Sharing failed', error);
});
} else {
// Fallback: Copy URL
if (navigator.clipboard && navigator.clipboard.writeText) {
navigator.clipboard.writeText(currentURL).then(() => {
showCopyNotification();
}, (err) => {
console.error('Could not copy text: ', err);
});
} else {
// Double fallback for older browsers
const textArea = document.createElement('textarea');
textArea.value = currentURL;
document.body.appendChild(textArea);
textArea.select();
try {
document.execCommand('copy');
showCopyNotification();
} catch (err) {
alert('Please copy this link:\\n' + currentURL);
}
document.body.removeChild(textArea);
}
}
});
})();
")
)
)
# ---- End: Minimal Share button snippet ----
),
# -- Body
dashboardBody(
tags$head(
tags$link(rel = "stylesheet", href = "https://fonts.cdnfonts.com/css/ocr-a-std"),
# Make the "play" button whiter/brighter
tags$style(HTML("
body {
font-family: 'OCR A Std', monospace !important;
}
.slider-animate-button {
background-color: #ffffff !important;
color: #000000 !important;
border: 2px solid #000000 !important;
border-radius: 5px !important;
padding: 5px 10px !important;
top: 10px !important;
}
"))
),
tabItems(
# ---------- MAP TAB ----------
tabItem(
tabName = "mapTab",
fluidRow(
# Value Boxes across the top for key stats
valueBoxOutput("highest_iwi_vb", width = 4),
valueBoxOutput("lowest_iwi_vb", width = 4),
valueBoxOutput("avg_iwi_vb", width = 4)
),
fluidRow(
# Map
box(
title = span("Wealth Map of Africa",
style = "font-family: 'OCR A Std', monospace; font-size: 18px;"),
width = 8, solidHeader = TRUE, status = "primary",
leafletOutput("map", height = "550px"),
p("Click anywhere on the map to view the time-series of IWI for that specific location (shown below).")
),
# Histogram
box(
title = span("IWI Distribution (Selected Period)",
style = "font-family: 'OCR A Std', monospace; font-size: 14px;"),
width = 4, solidHeader = TRUE, status = "info",
plotOutput("iwi_histogram", height = "250px"),
p("This histogram shows the distribution of the International Wealth Index (IWI) values for the selected time period across Africa."),
br(),
strong("Note:"),
" Wealth estimates for areas without human settlements have been excluded from the analysis.",
br(),br(),
p(HTML("[Paper PDF]"))
)
),
# Time series at clicked location
fluidRow(
box(
title = span("Time Series at Clicked Location",
style = "font-family: 'OCR A Std', monospace; font-size: 14px;"),
width = 12, solidHeader = TRUE, status = "warning",
plotOutput("clicked_ts_plot", height = "300px"),
p("Click on the map to see the full IWI time-series (1990–2019) for that location.")
)
)
),
# ---------- IMPROVEMENT DATA TAB ----------
tabItem(
tabName = "improvementTab",
fluidRow(
box(
width = 12,
title = span("Poverty Improvement by State",
style = "font-family: 'OCR A Std', monospace; font-size: 18px;"),
status = "primary", solidHeader = TRUE,
p("This table shows the estimated improvement in mean IWI between 1990–1992 and 2017–2019 for each province in Africa.
The 'Improvement' column indicates the change in IWI over this period. You can sort or filter the table,
and use the download button to export the data."),
downloadButton("download_data", "Download CSV", icon = icon("download")),
br(), br(),
DTOutput("improvement_table")
)
)
),
# ---------- TRENDS OVER TIME TAB ----------
tabItem(
tabName = "trendTab",
fluidRow(
box(
width = 12,
title = span("Average Wealth Index Across Africa Over Time",
style = "font-family: 'OCR A Std', monospace; font-size: 18px;"),
status = "success", solidHeader = TRUE,
p("This chart aggregates the mean IWI across all of Africa in each of the ten time periods.
It provides a high-level view of how wealth (as measured by IWI) has changed over time."),
plotOutput("trend_plot", height = "400px")
)
)
)
)
)
)
# ------------------------------
# 4. Server
# ------------------------------
server <- function(input, output, session) {
# ReactiveVal to store the time-series of the last clicked point (across all periods).
clicked_point_vals <- reactiveVal(NULL)
# ----------------------------------
# Reactive expression for selected raster layer
# ----------------------------------
selected_raster <- reactive({
req(input$time_index)
wealth_stack[[input$time_index]]
})
# ----------------------------------
# Custom color palette function
# (reactive to user-selected palette)
# ----------------------------------
color_pal <- reactive({
# Switch the user selection to a palette name
palette_choice <- switch(
input$color_palette,
"viridis" = "viridis",
"plasma" = "plasma",
"magma" = "magma",
"inferno" = "inferno",
"Spectral" = "Spectral"
)
# Create a single palette across *all* data (all_vals) using quantiles:
colorBin(
palette = palette_choice,
domain = all_vals,
bins = q_breaks,
na.color = "transparent"
)
})
color_pal_legend <- reactive({
# Switch the user selection to a palette name
palette_choice <- switch(
input$color_palette,
"viridis" = "viridis",
"plasma" = "plasma",
"magma" = "magma",
"inferno" = "inferno",
"Spectral" = "Spectral"
)
# Create a single palette across *all* data (all_vals) using quantiles:
colorBin(
palette = palette_choice,
domain = all_vals,
bins = q_breaks_legend,
na.color = "transparent"
)
})
# ----------------------------------
# Display the currently selected time period (year range)
# ----------------------------------
output$current_year_range <- renderText({
time_periods[input$time_index]
})
# ----------------------------------
# 1. MAP OUTPUT
# ----------------------------------
output$map <- renderLeaflet({
# We'll create 5 legend steps: 1, 0.75, 0.5, 0.25, 0
legend_values <- seq(1, 0, length.out = 5)
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 20, lat = 0, zoom = 3) %>% # Center on Africa
addLegend(
position = "bottomright",
pal = color_pal_legend(),
values = all_vals, # the entire distribution for the legend
title = "IWI",
opacity = 1
)
})
# Redraw the raster when inputs change
observeEvent(list(input$time_index, input$color_palette, input$opacity), {
leafletProxy("map") %>%
clearImages() %>%
addRasterImage(
selected_raster(),
colors = color_pal(),
opacity = input$opacity,
project = TRUE
)
})
# ----------------------------------
# Handle clicks on the map to show full time-series at that location
# ----------------------------------
observeEvent(input$map_click, {
click <- input$map_click
if (!is.null(click)) {
lat <- click$lat
lng <- click$lng
# Convert clicked point to SpatialPoints
coords <- data.frame(lng = lng, lat = lat)
sp_pt <- SpatialPoints(coords, proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs"))
# Extract values across ALL bands at the clicked location
extracted_vals <- raster::extract(wealth_stack, sp_pt)
# extracted_vals is a 1x10 matrix if the point is valid
if (!is.null(extracted_vals)) {
# Convert to numeric vector
clicked_point_vals(as.numeric(extracted_vals))
} else {
# If the point is outside the raster or invalid
clicked_point_vals(NULL)
}
}
})
# Plot the time-series for the clicked location
output$clicked_ts_plot <- renderPlot({
vals <- clicked_point_vals()
if (is.null(vals)) {
# No location clicked yet or invalid click
plot.new()
title("Click on the map to see the IWI time-series here.")
return()
}
# If user clicked in a region with all NAs, do not plot
if (all(is.na(vals))) {
plot.new()
title("No data at this location. Try another spot.")
return()
}
df <- data.frame(Period = factor(time_periods, levels = time_periods),
IWI = vals)
ggplot(df, aes(x = Period, y = IWI, group = 1)) +
geom_line(color = "darkorange", size = 1) +
geom_point(color = "darkorange", size = 2) +
labs(title = "Time Series of IWI at Clicked Location",
x = "Time Period",
y = "IWI (0 to 1)") +
ylim(0, 1) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
})
# ----------------------------------
# 2. HISTOGRAM OUTPUT (for selected time period)
# ----------------------------------
output$iwi_histogram <- renderPlot({
# Extract raster values for histogram
r_vals <- values(selected_raster())
r_vals <- r_vals[!is.na(r_vals)]
ggplot(data.frame(iwi = r_vals), aes(x = iwi)) +
geom_histogram(binwidth = 0.02, fill = "#2c7bb6", color = "white", alpha = 0.7) +
labs(x = "IWI (0 to 1)", y = "Frequency") +
theme_minimal(base_size = 14)
})
# ----------------------------------
# 3. VALUE BOXES FOR KEY STATS
# ----------------------------------
# Compute stats for current raster
raster_stats <- reactive({
r_vals <- values(selected_raster())
r_vals <- r_vals[!is.na(r_vals)]
list(
highest = max(r_vals, na.rm = TRUE),
lowest = min(r_vals, na.rm = TRUE),
average = mean(r_vals, na.rm = TRUE)
)
})
# Highest IWI
output$highest_iwi_vb <- renderValueBox({
valueBox(
value = round(raster_stats()$highest, 3),
subtitle = "Highest IWI",
icon = icon("arrow-up"),
color = "green"
)
})
# Lowest IWI
output$lowest_iwi_vb <- renderValueBox({
valueBox(
value = round(raster_stats()$lowest, 3),
subtitle = "Lowest IWI",
icon = icon("arrow-down"),
color = "red"
)
})
# Average IWI
output$avg_iwi_vb <- renderValueBox({
valueBox(
value = round(raster_stats()$average, 3),
subtitle = "Average IWI",
icon = icon("balance-scale"),
color = "blue"
)
})
# ----------------------------------
# 4. IMPROVEMENT DATA TABLE
# ----------------------------------
output$improvement_table <- renderDT({
datatable(
improvement_data,
filter = "top",
options = list(
scrollX = TRUE,
pageLength = 20,
autoWidth = TRUE
)
)
})
# Download CSV
output$download_data <- downloadHandler(
filename = function() {
paste0("poverty_improvement_", Sys.Date(), ".csv")
},
content = function(file) {
write.csv(improvement_data, file, row.names = FALSE)
}
)
# ----------------------------------
# 5. TRENDS OVER TIME (line chart of mean IWI across all Africa)
# ----------------------------------
output$trend_plot <- renderPlot({
df <- data.frame(
Period = factor(time_periods, levels = time_periods),
MeanIWI = band_means
)
ggplot(df, aes(x = Period, y = MeanIWI, group = 1)) +
geom_line(color = "#2c7bb6", size = 1.1) +
geom_point(color = "#2c7bb6", size = 2) +
labs(
title = "Average IWI Over Time (Africa)",
x = "Time Period",
y = "Mean IWI"
) +
ylim(0.1, 0.3) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
})
}
# ------------------------------
# 6. Run the App
# ------------------------------
shinyApp(ui = ui, server = server)
}