-
Jorge Saturno authoredJorge Saturno authored
app.R 13.77 KiB
# This is a Shiny web application.
# Dashboard to visualize data presented in review paper Asmi et al. (2025).
# See README for more details.
library(shiny)
library(shinythemes)
library(bslib)
library(ggiraph)
library(ggsci)
library(ggiraphExtra)
library(stringr)
library(reshape2)
library(scales)
library(tidyverse)
library(DT)
library(gdtools)
# library(systemfonts)
# library(hrbrthemes)
register_gfont("IBM Plex Sans")
# Define UI for application
ui <- page_sidebar(
title = "⚫ Atmospheric black carbon MAC review",
theme = bs_theme(bootswatch = "minty"),
addGFontHtmlDependency(family = c("IBM Plex Sans")),
# tags$head(tags$style(type="text/css", "text {font-family: sans-serif}")),
sidebar = sidebar(
h4("Chart settings"),
radioButtons("plot_category", "Categories",
c("Aerosol Type" = "Aerosol_type",
"Absorption measurement" = "Abs_meas",
"Mass measurement" = "Mass_meas"),
selected = "Aerosol_type"
),
p("For more details and a reference to this review study, see the About section."),
tags$a(
href="https://stanbc.com",
tags$img(src="stanBC_logo_square_transp.png",
width="100%",
)
)
),
navset_card_underline(
# title = "Title",
nav_panel("List of studies", girafeOutput("StudyPlot")),
nav_panel("MAC vs. λ", girafeOutput("LambdaPlot")),
nav_panel("Table", DT::dataTableOutput('MACtable')),
nav_panel("About", uiOutput("README"))
)
)
# Define server logic required to output plots and tables
server <- function(input, output) {
register_gfont("IBM Plex Sans")
# Data processing
MAC_data <- read_delim("data/MAC_table.csv", ",", skip = 1,
col_names = c("MAC_m2g", "MAC_sd", "MAC_method", "Wavelength_nm",
"AAE", "Season", "Continent", "Time_period",
"Place", "Aerosol_source", "Aerosol_type",
"Mass_ref", "Abs_ref", "TD", "Thermal_protocol",
"Abs_correction", "C_factor", "Other_info",
"Reference_study", "id", "duration_code"))
# Reduce the amount of aerosol types
MAC_data$Aerosol_type_red <- ifelse(MAC_data$Aerosol_type %in% c("arctic",
"remote",
"regional background"),
"remote & regional background", MAC_data$Aerosol_type)
MAC_data$Aerosol_type_red <- ifelse(MAC_data$Aerosol_type %in% c("polluted",
"urban",
"suburban",
"urban background",
"traffic"),
"urban", MAC_data$Aerosol_type_red)
MAC_data$Aerosol_type_red <- ifelse(MAC_data$Aerosol_type %in% c("outflow",
"high-altitude"
),
"high altitude & outflow", MAC_data$Aerosol_type_red)
MAC_data$Aerosol_type_red <- ifelse(MAC_data$Aerosol_type %in% c("rural",
"mixed"
),
"rural & mixed", MAC_data$Aerosol_type_red)
# Reduce the amount of abs reference options
MAC_data$Abs_ref_red <- NA
MAC_data$Abs_ref_red <- ifelse(MAC_data$Abs_ref %in% c("AE", "AE16", "AE21",
"AE22", "AE31", "AE31, AE33",
"AE33", "AE42", "ATN",
"MAAP", "PSAP", "PSAP,CLAP",
"CLAP"),
"Filter-based", MAC_data$Abs_ref_red)
MAC_data$Abs_ref_red <- ifelse(MAC_data$Abs_ref %in% c("PA", "PAS"),
"Photoacoustic", MAC_data$Abs_ref_red)
# Reduce the amount of mass reference options
MAC_data$Mass_ref_red <- NA
MAC_data$Mass_ref_red <- ifelse(MAC_data$Mass_ref %in% c("SP2", "NRC-LII"),
"SP2", MAC_data$Mass_ref_red)
MAC_data$Mass_ref_red <- ifelse(MAC_data$Mass_ref %in% c("Raman Spectroscopy"),
NA, MAC_data$Mass_ref_red)
MAC_data$Mass_ref_red <- ifelse(MAC_data$Mass_ref %in% c("EC"),
"EC", MAC_data$Mass_ref_red)
MAC_data$Mass_ref_red <- ifelse(MAC_data$Mass_ref %in% c("SP2-AMS"),
"SP2-AMS", MAC_data$Mass_ref_red)
# Calculate MAC at 550 nm
MAC_data <- MAC_data |>
mutate(
MAC_m2g_550 = MAC_m2g * (550/Wavelength_nm)^(-1), # Calculate abs coeff for 550 nm
MAC_sd_550 = MAC_sd * (550/Wavelength_nm)^(-1), # Calculate MAC SD for 550 nm
MAC_sd_550_durn = ifelse(duration_code > 2, MAC_sd * (550/Wavelength_nm)^(-1), NA), # Same as above but only for studies with duration of months and years
Eabs = MAC_m2g_550 / 8.0, # Calculate abs enhancement compared to the standard abs coeff at 550 nm (8.0 m2g-1)
Study_durn = case_when(
duration_code == 1 ~ paste("Days"), # Adds extra character to the study name according to duration
duration_code == 2 ~ paste("Weeks"),
duration_code == 3 ~ paste("Months"),
duration_code == 4 ~ paste("Years"),
)
)
# Plot MAC550 as list of studies
output$StudyPlot <- renderGirafe({
# Plot MAC 550 using facet for aerosol type
MAC_MAC550 <- ggplot(MAC_data, aes(x = Reference_study, y = MAC_m2g_550))
MAC_MAC550.gg <- MAC_MAC550 +
# theme_ipsum(base_family = "IBM Plex Sans") +
theme_minimal(base_family = "IBM Plex Sans") +
theme(axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(size=16),
axis.title.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
strip.text.y = element_text(angle = 0, size = 16),
strip.background = element_rect(colour="#FFFFFF", fill="#f7f7f9"),
legend.background = element_rect(fill = "#f7f7f9", colour = "#FFFFFF"),
legend.text = element_text(size = 12),
legend.title=element_blank()
) +
xlab("Study") +
ylab(expression(paste(italic(E)[abs], " • ", MAC[550], " [m²/g]"))) +
scale_color_manual(values = c("#0072B5", "#7cb518", "#ffb703", "#e63946")) +
coord_flip() +
scale_x_discrete(limits=rev) +
geom_rect(aes(ymin=7, ymax=9, xmin=0, xmax=Inf), fill = "#EEEEEE") +
geom_hline(yintercept = 8, linetype = 2, linewidth = 1) +
geom_linerange_interactive(aes(ymin = MAC_m2g_550 - MAC_sd_550,
ymax =MAC_m2g_550 + MAC_sd_550,
colour = case_when(
input$plot_category == "Aerosol_type" ~ Aerosol_type_red,
input$plot_category == "Abs_meas" ~ Abs_ref_red,
input$plot_category == "Mass_meas" ~ Mass_ref_red
),
data_id = case_when(
input$plot_category == "Aerosol_type" ~ Aerosol_type_red,
input$plot_category == "Abs_meas" ~ Abs_ref_red,
input$plot_category == "Mass_meas" ~ Mass_ref_red
)),
linewidth=4, alpha = 0.15) +
geom_text(family = "Arial", size = 9,label = "\u2727",
colour = "#FFFFFF", show.legend = FALSE,
position = position_nudge(x = 0.1)) + # Simulation of stroke line
geom_text(family = "Arial", size = 6,label = "\u2727",
colour = "#777777", show.legend = FALSE,
position = position_nudge(x = 0.1)) + # Simulation of stroke line
geom_text_interactive(aes(colour = case_when(
input$plot_category == "Aerosol_type" ~ Aerosol_type_red,
input$plot_category == "Abs_meas" ~ Abs_ref_red,
input$plot_category == "Mass_meas" ~ Mass_ref_red
),
data_id = case_when(
input$plot_category == "Aerosol_type" ~ Aerosol_type_red,
# input$plot_category == "Abs_meas" ~ Abs_ref_red,
input$plot_category == "Mass_meas" ~ Mass_ref_red
),
tooltip = paste(Reference_study, "\n", round(MAC_m2g_550, digits = 2), " m²/g")),
family = "Arial", size = 6, label = "\u2726",
alpha = 0.7, show.legend = TRUE,
position = position_nudge(x = 0.1)) + # Fill character in front
facet_grid(Study_durn ~ ., scales = "free", space = "free")
girafe(ggobj = MAC_MAC550.gg, width_svg = 14, height_svg = 10,
# fonts = list(sans = "Arial"),
options = list(
opts_hover(css = "fill:grey80;"),
opts_hover_inv(css = "opacity:0.1;"),
opts_selection(type = "single", only_shiny = FALSE)
))
})
# Plot MAC as function of wavelength output$LambdaPlot <- renderGirafe({
# Plot MAC 550 using facet for aerosol type
MAC_lambda <- ggplot(MAC_data, aes(x = Wavelength_nm, y = MAC_m2g))
MAC_lambda.gg <- MAC_lambda +
# theme_ipsum(base_family = "IBM Plex Sans") +
theme_minimal(base_family = "IBM Plex Sans") +
theme(axis.text.y = element_text(size = 10),
axis.text.x = element_text(size = 12),
axis.title.x = element_text(size=16),
axis.title.y = element_text(size=16),
strip.text.y = element_text(angle = 0, size = 16),
strip.background = element_rect(colour="#FFFFFF", fill="#f7f7f9"),
legend.background = element_rect(fill = "#f7f7f9", colour = "#FFFFFF"),
legend.text = element_text(size = 12),
legend.title=element_blank()
) +
xlab("Wavelength [nm]") +
ylab(expression(paste(italic(E)[abs], " • ", MAC[λ], " [m²/g]"))) +
scale_x_continuous(breaks = seq(100, 1000, 100), limits = c(300, 1000)) +
coord_trans(x = "log10") +
scale_color_manual(values = c("#0072B5", "#7cb518", "#ffb703", "#e63946")) +
stat_function(fun=function(x) 4400 * (x)^(-1), linetype = 2) +
stat_function(fun=function(x) 8800 * (x)^(-1), linetype = 2) +
geom_text(family = "Arial", size = 10,label = "\u2727",
colour = "#FFFFFF", show.legend = FALSE,
position = position_nudge(x = 0.1)) + # Simulation of stroke line
geom_text(family = "Arial", size = 7,label = "\u2727",
colour = "#777777", show.legend = FALSE,
position = position_nudge(x = 0.1)) + # Simulation of stroke line
geom_text_interactive(aes(colour = case_when(
input$plot_category == "Aerosol_type" ~ Aerosol_type_red,
input$plot_category == "Abs_meas" ~ Abs_ref_red,
input$plot_category == "Mass_meas" ~ Mass_ref_red
),
data_id = case_when(
input$plot_category == "Aerosol_type" ~ Aerosol_type_red,
input$plot_category == "Abs_meas" ~ Abs_ref_red,
input$plot_category == "Mass_meas" ~ Mass_ref_red
),
tooltip = paste(Reference_study, "\n", round(MAC_m2g, digits = 2), " m²/g")),
family = "Arial", size = 7, label = "\u2726",
alpha = 0.7, show.legend = TRUE,
position = position_nudge(x = 0.1)) + # Fill character in front
annotate("text", x=335, y=14.8, family = "IBM Plex Sans", label= expression(paste(italic(E)[abs], " = 1; AAE = 1"))) +
annotate("text", x=335, y=29, family = "IBM Plex Sans", label= expression(paste(italic(E)[abs], " = 2; AAE = 1")))
girafe(ggobj = MAC_lambda.gg, width_svg = 14, height_svg = 10,
# fonts = list(sans = "Arial"),
options = list(
opts_hover(css = "fill:grey80;"),
opts_hover_inv(css = "opacity:0.1;"),
opts_selection(type = "single", only_shiny = FALSE)
))
})
output$MACtable <- DT::renderDataTable({
DT::datatable(MAC_data[, c("MAC_m2g", "MAC_sd", "MAC_method", "Wavelength_nm",
"AAE", "Season", "Continent", "Time_period",
"Place", "Aerosol_source", "Aerosol_type",
"Mass_ref", "Abs_ref", "TD", "Thermal_protocol",
"Abs_correction", "C_factor", "Reference_study")],
rownames = FALSE,
style = "bootstrap",
options = list(pageLength = 300))
})
output$README <- renderUI({
withMathJax(HTML(readLines(rmarkdown::render(input = "README.md",
output_format = rmarkdown::html_fragment(),
quiet = TRUE
))))
})
}
# Run the application
shinyApp(ui = ui, server = server)