Hi,
I am following up with a previous topic. I am trying to create a Shiny app. I have both my UI and Server scripts (copied below) working with no issues. When I run the app, unfortunately, the graph I hope to display does not. Instead a long message appears in my console asking me to "enter a frame number or 0 to exit" (see below for actual message). I cannot scale down the problem for reproducibility for a reason. I tried running the default shiny app using the geysers data frame and it worked. So I believe it is the complexity of the task.my app that is causing an issue but I don't understand the actual message returned in the console. Hence, I have copied the scripts below as well as the google drive link to the data I am using. Appreciate any help on this urgent problem - I have tried looking on stackoverflow and rcommunity studio but have not encountered other posts on this. I have also updated R, R studio, and all packages.
Many thanks,
Stanley
UI Script
library(shiny)
library(plotly)
options(shiny.error = recover)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# 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)
),
mainPanel(width = 9,
column(width = 8.5, offset = 0.5,
br(),
plotlyOutput('graph_1'),
),
)
),
br(),
br()
# shiny::fluidRow(
# column(width = 4.5,
# br(),
# plotlyOutput('graph_2')
# ), #global level graph
# column(width = 3,
# plotlyOutput('graph_2')
# ), # toggles for time series graph
# column(width = 4.5,
# plotlyOutput('graph_2')
# #plotOutput('graph_3', width = "100%")
# ) # time series graph - country level
#)
))
Server script
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({emdat_final})
metric_df <- reactive({spec(metric_df())})
metric_df <- reactive({metric_df() %>%
filter(start_year() <= yr,
yr <= end_year(),
d_type %in% c(disaster()) %>% ## 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))})
reactive({data.table::setnames((metric_df()), 3, "newvar")})
metric_df <- reactive({metric_df() %>%
dplyr::summarise(metric = sum(newvar, na.rm=T)) %>%
mutate(metric = round(metric, 0))})
### financing
finance_df <- reactive({finance_tot %>%
filter(start_year() <= year,
year <= end_year()) %>%
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(metric(), "from", start_year(), "to",
end_year(), sep = " ")})
g1_subtitle <- reactive({paste("Cause(s):", disaster(), 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 <- renderPlotly({
fordisplay1 <- reactive({print(g1())})
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(metric(), "from", start_year(), "to",
# end_year(),
# sep = " ")})
#
# g2 <- reactive({ggplot(data = g2_df(), aes(x=(metric),
# y = (g2_df$sum/(1000000)),
# #label = ctry,
# col = cont)) +
# geom_point(alpha = 0.6,
# aes(text = paste0("Country: ", `ctry`, "\n",
# "Metric: ", `metric`, "\n",
# "Funding: ", signif(g2_df$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",
# start_year(), "to", end_year(), 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 <- renderPlotly({
# fordisplay2 <- reactive({print(g2())})
# if(input$button>=1){(print(fordisplay2()))}
# })
### graph_3 - country level graph (metric & money against time)
})
Console:
> runApp('FGCD')
Listening on http://127.0.0.1:7667
New names:
• `` -> `...1`
Rows: 8025 Columns: 11
── Column specification ───────────
Delimiter: ","
chr (3): iso, d_type, ctry
dbl (8): ...1, yr, Lives Lost, ...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Rows: 10914 Columns: 7
── Column specification ───────────
Delimiter: ","
chr (3): Country, source, iso
dbl (4): X, year, total_usd, us...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
**Enter a frame number, or 0 to exit**
1: runApp("FGCD")
2: ..stacktraceoff..(captureStackTraces({
3: captureStackTraces({
while (!.globals
4: promises::with_promise_domain(createStac
5: domain$wrapSync(expr)
6: withCallingHandlers(expr, error = doCapt
7: ..stacktracefloor..(serviceApp())
8: serviceApp()
9: flushReact()
10: .getReactiveEnvironment()$flush()
11: ctx$executeFlushCallbacks()
12: lapply(.flushCallbacks, function(flushCa
13: FUN(X[[i]], ...)
14: flushCallback()
15: hybrid_chain({
if (!.destroyed) {
16: do()
17: tryCatch({
captureStackTraces({
18: tryCatchList(expr, classes, parentenv, h
19: tryCatchOne(expr, names, parentenv, hand
20: doTryCatch(return(expr), name, parentenv
21: captureStackTraces({
result <- withVi
22: promises::with_promise_domain(createStac
23: domain$wrapSync(expr)
24: withCallingHandlers(expr, error = doCapt
25: withVisible(force(expr))
26: force(expr)
27: shinyCallingHandlers(run())
28: withCallingHandlers(captureStackTraces(e
29: captureStackTraces(expr)
30: promises::with_promise_domain(createStac
31: domain$wrapSync(expr)
32: withCallingHandlers(expr, error = doCapt
33: run()
34: ctx$run(.func)
35: promises::with_promise_domain(reactivePr
36: domain$wrapSync(expr)
37: withReactiveDomain(.domain, {
env <-
38: promises::with_promise_domain(createVarP
39: domain$wrapSync(expr)
40: force(expr)
41: env$runWith(self, func)
42: contextFunc()
43: `<observer:output$graph_1>`(...)
44: observe()
45: hybrid_chain(hybrid_chain({
private$w
46: do()
47: tryCatch({
captureStackTraces({
48: tryCatchList(expr, classes, parentenv, h
49: tryCatchOne(expr, names, parentenv, hand
50: doTryCatch(return(expr), name, parentenv
51: captureStackTraces({
result <- withVi
52: promises::with_promise_domain(createStac
53: domain$wrapSync(expr)
54: withCallingHandlers(expr, error = doCapt
55: withVisible(force(expr))
56: force(expr)
57: hybrid_chain({
private$withCurrentOut
58: do()
59: tryCatch({
captureStackTraces({
60: tryCatchList(expr, classes, parentenv, h
61: tryCatchOne(expr, names, parentenv, hand
62: doTryCatch(return(expr), name, parentenv
63: captureStackTraces({
result <- withVi
64: promises::with_promise_domain(createStac
65: domain$wrapSync(expr)
66: withCallingHandlers(expr, error = doCapt
67: withVisible(force(expr))
68: force(expr)
69: private$withCurrentOutput(name, {
shi
70: promises::with_promise_domain(createVarP
71: domain$wrapSync(expr)
72: force(expr)
73: shinyCallingHandlers(func())
74: withCallingHandlers(captureStackTraces(e
75: captureStackTraces(expr)
76: promises::with_promise_domain(createStac
77: domain$wrapSync(expr)
78: withCallingHandlers(expr, error = doCapt
79: func()
80: orig(name = name, shinysession = self)
81: ..stacktraceon..(`output$graph_1`(...))
82: `output$graph_1`(...)
83: renderFunc(...)
84: hybrid_chain(func(), function(value) {
85: do()
86: tryCatch({
captureStackTraces({
87: tryCatchList(expr, classes, parentenv, h
88: tryCatchOne(expr, names, parentenv, hand
89: value[[3]](cond)
90: stop(e)
91: (function (e)
{
if (is.null(attr(e, "
92: stop(e)
93: (function (e)
{
if (cnd_inherits(e, "
Session info
R version 4.2.1 (2022-06-23 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19044)
Matrix products: default
locale:
[1] LC_COLLATE=English_Singapore.utf8
[2] LC_CTYPE=English_Singapore.utf8
[3] LC_MONETARY=English_Singapore.utf8
[4] LC_NUMERIC=C
[5] LC_TIME=English_Singapore.utf8
attached base packages:
[1] stats graphics grDevices
[4] utils datasets methods
[7] base
other attached packages:
[1] magrittr_2.0.3
[2] forcats_0.5.2
[3] stringr_1.4.1
[4] dplyr_1.0.10
[5] purrr_0.3.5
[6] readr_2.1.3
[7] tidyr_1.2.1
[8] tibble_3.1.8
[9] tidyverse_1.3.2
[10] plotly_4.10.0
[11] ggplot2_3.3.6
[12] shiny_1.7.2
loaded via a namespace (and not attached):
[1] Rcpp_1.0.9
[2] lubridate_1.8.0
[3] countrycode_1.4.0
[4] assertthat_0.2.1
[5] digest_0.6.29
[6] utf8_1.2.2
[7] mime_0.12
[8] R6_2.5.1
[9] cellranger_1.1.0
[10] backports_1.4.1
[11] reprex_2.0.2
[12] httr_1.4.4
[13] pillar_1.8.1
[14] rlang_1.0.6
[15] lazyeval_0.2.2
[16] googlesheets4_1.0.1
[17] readxl_1.4.1
[18] rstudioapi_0.14
[19] data.table_1.14.2
[20] jquerylib_0.1.4
[21] googledrive_2.0.0
[22] htmlwidgets_1.5.4
[23] bit_4.0.4
[24] munsell_0.5.0
[25] broom_1.0.1
[26] compiler_4.2.1
[27] httpuv_1.6.6
[28] modelr_0.1.9
[29] pkgconfig_2.0.3
[30] htmltools_0.5.3
[31] tidyselect_1.2.0
[32] fansi_1.0.3
[33] viridisLite_0.4.1
[34] crayon_1.5.2
[35] tzdb_0.3.0
[36] dbplyr_2.2.1
[37] withr_2.5.0
[38] later_1.3.0
[39] grid_4.2.1
[40] jsonlite_1.8.2
[41] xtable_1.8-4
[42] gtable_0.3.1
[43] lifecycle_1.0.3
[44] DBI_1.1.3
[45] scales_1.2.1
[46] vroom_1.6.0
[47] stringi_1.7.8
[48] cli_3.4.1
[49] cachem_1.0.6
[50] fs_1.5.2
[51] promises_1.2.0.1
[52] xml2_1.3.3
[53] bslib_0.4.0
[54] ellipsis_0.3.2
[55] generics_0.1.3
[56] vctrs_0.4.2
[57] tools_4.2.1
[58] bit64_4.0.5
[59] glue_1.6.2
[60] hms_1.1.2
[61] parallel_4.2.1
[62] fastmap_1.1.0
[63] yaml_2.3.5
[64] colorspace_2.0-3
[65] gargle_1.2.1
[66] rvest_1.0.3
[67] memoise_2.0.1
[68] haven_2.5.1
[69] sass_0.4.2