Hi,
I need urgent help with an issue. I am creating a r shiny app to display 2 graphs. Both my UI and Server R scripts are working fine. When I launch the shiny app, no errors are returned. But both graphs are not appearing. I have looked at many stackoverflow and similar pages, but precisely because no errors are returned in my console, I am having difficulty troubleshooting. Appreciate any help on this. I have copied my UI and Server scripts below.
Many thanks,
Stanley
Server
library(shiny)
library(tidyverse)
library(plotly)
library(magrittr)
options(scipen = 999)
options(scipen = 0) # to enable scientific notation like e+05
loading data
emdat_final <- read_csv("emdat_final.csv")
finance_tot <- read_csv("finance_tot.csv")
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
server
shinyServer(function(input, output, session){
bringing in input values
# start_year <- reactive({input$start_year_input})
# end_year <- reactive({input$end_year_input})
# metric <- reactive({c(input$metric_input)})
# disaster <- reactive({input$disaster_input})
generating dataframes for plots
### metrics of risk
#detach(package:plyr)
metric_df <- reactive({data.frame(emdat_final()) %>%
filter(input$start_year_input() <= yr,
yr <= input$end_year_input(),
d_type %in% c(input$disaster_input()) == T) %>% ## filter for years and disaster
select(iso, ctry, yr, d_type, (input$metric_input())) %>% ## select column for metric
mutate(iso = as.factor(iso),
ctry = as.factor(ctry)) %>%
dplyr::group_by(ctry, iso) %>% ## grouping works from glimpse output
select(-yr, -d_type)})
# for testing...
# start_year <- 1990
# end_year <- 2015
# metric <- "Economic Damages"
# disaster <- "Flood"
#
# metric_df <- emdat_final %>%
# filter(start_year <= yr,
# yr <= end_year,
# d_type %in% c(disaster) == T) %>% ## filter for years and disaster
# select(iso, ctry, yr, d_type, (metric)) %>% ## select column for metric
# mutate(iso = as.factor(iso),
# ctry = as.factor(ctry)) %>%
# dplyr::group_by(ctry, iso) %>% ## grouping works from glimpse output
# select(-yr, -d_type)
#colnames(metric_df) <- c("iso", "ctry", "newvar")
reactive({data.table::setnames(as.data.frame(metric_df()), 3, "newvar")})
metric_df <- reactive({metric_df() %>%
dplyr::summarise(metric = sum(newvar, na.rm=T)) %>%
mutate(metric = round(metric, 0))})
#### I have no idea why grouping does not work. it only groups by
#### ctry and not iso. peeling shouldnt be working this way!
### cases and NA
# cases_df <- tot_cases(s_yr = start_year,
# e_yr = end_year) %>%
# filter(d_type %in% c(disaster)) %>%
# mutate(ctry = iso) %>%
# mutate(ctry = countrycode::countrycode(ctry, origin = "iso3c",
# destination = "country.name"))
#
### financing
finance_df <- reactive({finance_tot() %>%
filter(input$start_year_input <= year & year <= input$end_year_input) %>%
mutate(ctry = iso) %>%
mutate(ctry = countrycode::countrycode(ctry, origin = "iso3c",
destination = "country.name")) %>%
mutate(total_usd = coalesce(total_usd, usd_div)) %>%
select(ctry, iso, total_usd) %>%
group_by(ctry, iso) %>%
summarize(sum = sum(total_usd, na.rm = T)) %>%
ungroup()})
defining plotly aesthetics
m <- list(
l = 0.5,
r = 0.5,
b = 0,
t = 0,
pad = 3
)
g <- list(
lonaxis = list(showgrid = T),
lataxis = list(showgrid = T),
showland = TRUE,
landcolor = toRGB("#e5ecf6"),
fitbounds = "locations"
)
generating plots
### graph_1 - global atlas
g1_title <- reactive({paste(input$metric_input, "from", input$start_year_input, "to",
input$end_year_input, sep = " ")})
g1_subtitle <- reactive({paste("Cause(s):", input$disaster_input, sep = " ")})
g1 <- reactive({plot_ly(df = metric_df(),
type = "choropleth",
locations = metric_df$iso,
z = ceiling(metric_df$metric),
text = metric_df$ctry,
colorscale = "Viridis",
reversescale = T) %>%
layout(autosize = T, geo = g(),
#width = 600, height = 350, margin = m
title = list(text = g1_title(), xanchor = 'center',
yanchor = 'bottom', x = 0.5, y=0.9,
size = 1),
subtitle = g1_subtitle()) %>%
colorbar(thickness = 20, len = 0.6)})
output$graph_1 <- renderPlot({
fordisplay1 <- reactive({print(g1)})
if(input$button>=1){(print(fordisplay1()))}
})
#add causes; data accurate as of ____; source: _____; change color?
### graph_2 - global level graph (x:y)
#### merging finance and emdat_final first
g2_df <- reactive({metric_df() %>%
inner_join(finance_df()) %>%
mutate(cont = countrycode::countrycode(iso, origin = "iso3c",
destination = "continent"))})
g2_xlab <- reactive({paste(input$metric_input, "from", input$start_year_input, "to",
input$end_year_input,
sep = " ")})
g2 <- reactive({ggplot(data = g2_df(), aes(x=(metric),
y = (sum/1000000),
#label = ctry,
col = cont)) +
geom_point(alpha = 0.6,
aes(text = paste0("Country: ", `ctry`, "\n",
"Metric: ", `metric`, "\n",
"Funding: ", signif(sum,digits =3),
sep = ""))) +
geom_smooth(method='lm', formula= y~x,
col="black", se =F,
linetype="dashed") +
ylab(paste("Climate Adaptation Funding (million)\n from",
input$start_year_input, "to", input$end_year_input, sep = " ")) +
xlab(g2_xlab()) +
scale_color_discrete(name = "Continent") +
theme_classic() +
theme(axis.text.x = element_text(size=7),
axis.text.y= element_text(size = 7),
legend.text = element_text(size = 7),
legend.title = element_text(size = 9),
axis.title.x = element_text(size=8),
axis.title.y=element_text(size=8))})
g2 <- reactive({ggplotly(g2(), tooltip = "text")})
output$graph_2 <- renderPlot({
fordisplay2 <- reactive({print(g2)})
if(input$button>=1){(print(fordisplay2()))}
})
})
UI
library(shiny)
Define UI for application that draws a histogram
shinyUI(fluidPage(theme="bootstrap_superhero.css",
# Application title
titlePanel("Finance for Global Climate Adaptation and Resilience"),
sidebarLayout(
sidebarPanel(width = 3,
## choosing the disasters of interest
h5('Adjust the options below to view the desired graph.'),
checkboxGroupInput('disaster_input', 'Select type of disaster:',
c('Flood', 'Landslide', 'Extreme temperature',
'Insect infestation', "Epidemic",
"Storm", "Wildfire",
"Drought", "Mass movement (dry)" #add on here
), selected = "Flood"),
br(),
## choosing metrics of interest
selectInput('metric_input', 'Select impact metric:',
c('Lives Lost', 'Humans Affected',
'Economic Damages',
'Lives Lost per 100,000 people',
"Humans Affected per 100,000 people",
"Economic Damages (CPI)" #add on here
), selected = "Lives Lost"),
br(),
sliderInput('start_year_input', 'Select start year',
min = 1969, max = 2020, value = 2000),
br(),
sliderInput('end_year_input', 'Select end year',
min = 1969, max = 2020, value = 2010),
br(),
actionButton('button', label = 'Enter')
),
mainPanel(width = 9,
column(width = 8.5, offset = 0.5,
br(),
plotOutput('graph_1'),
),
)
),
br(),
br(),
shiny::fluidRow(
column(width = 4.5,
br(),
plotOutput('graph_2')
), #global level graph
column(width = 3,
plotOutput('graph_2')
), # toggles for time series graph
column(width = 4.5,
plotOutput('graph_2')
#plotOutput('graph_3', width = "100%")
) # time series graph - country level
)
))
R version 4.0.3 (2020-10-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19044)
Matrix products: default
locale:
[1] LC_COLLATE=English_Singapore.1252
[2] LC_CTYPE=English_Singapore.1252
[3] LC_MONETARY=English_Singapore.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_Singapore.1252
attached base packages:
[1] stats graphics grDevices utils
[5] datasets methods base
other attached packages:
[1] magrittr_2.0.1 plotly_4.9.2.1
[3] forcats_0.5.0 stringr_1.4.0
[5] dplyr_1.0.5 purrr_0.3.4
[7] readr_1.4.0 tidyr_1.1.3
[9] tibble_3.1.0 ggplot2_3.3.3
[11] tidyverse_1.3.0 shiny_1.5.0
loaded via a namespace (and not attached):
[1] tidyselect_1.1.0 haven_2.3.1
[3] colorspace_2.0-0 vctrs_0.3.6
[5] generics_0.1.0 viridisLite_0.3.0
[7] htmltools_0.5.1.1 utf8_1.1.4
[9] rlang_0.4.10 later_1.1.0.1
[11] pillar_1.5.1 withr_2.4.1
[13] glue_1.4.2 DBI_1.1.0
[15] dbplyr_2.0.0 sessioninfo_1.1.1
[17] modelr_0.1.8 readxl_1.3.1
[19] lifecycle_1.0.0 munsell_0.5.0
[21] gtable_0.3.0 cellranger_1.1.0
[23] rvest_0.3.6 htmlwidgets_1.5.3
[25] fastmap_1.0.1 httpuv_1.5.4
[27] fansi_0.4.2 broom_0.7.5
[29] Rcpp_1.0.5 xtable_1.8-4
[31] promises_1.1.1 backports_1.2.1
[33] scales_1.1.1 jsonlite_1.7.2
[35] countrycode_1.2.0 mime_0.9
[37] fs_1.5.0 hms_1.0.0
[39] digest_0.6.27 stringi_1.5.3
[41] grid_4.0.3 cli_2.3.1
[43] tools_4.0.3 lazyeval_0.2.2
[45] crayon_1.4.1 pkgconfig_2.0.3
[47] ellipsis_0.3.1 data.table_1.13.4
[49] xml2_1.3.2 reprex_0.3.0
[51] lubridate_1.7.9.2 rstudioapi_0.13
[53] assertthat_0.2.1 httr_1.4.2
[55] R6_2.5.0 compiler_4.0.3