Hi there,
I'm a beginner and this is also my first request for help with R . If I've not followed all guidelines for posting please let me know.
Edit #2: there's a lot of text and code below. Apologies. I think my core request is if anyone can look at my shiny script (first chunk of code) and my use of observe, if, and else if in the server and see if there's anything that would stop the app from deploying online? It runs fine from my computer.
Edit to explain what I'm trying to do with this app: I want users to select a year level (education context), and for that choice to determine what classes are available for selection in the second selectInput. So, if they choose 'year 8', only year 8 classes (8A, 8B etc) appear as options for their second choice Depending on their selections, student growth data for that year level or class is rendered End edit
The following shiny app runs locally but fails when deployed online. I'm very new to Shiny but have written a couple of apps before this one. Another had the same issue and I was able to debug it (problem was renaming a horrendously named column that formatted differently when the csv was read by the shinyapps server).
This time I'm stumped.
An earlier version of this app deployed fine but had some other problems so I rewrote it (moved conditionality from UI to server). As such, I don't think it's the data or the 'pat_growth.r' script the app calls (also included below) that is the issue. I think it's the conditional UI but it's my first go at this sort of conditionality so I'm unsure what the problem might be.
Shiny code:
library(ggiraph)
library(tidyverse)
library(janitor)
#conflicted::conflict_prefer("filter", "dplyr")
source("pat_growth.R")
# Define User Interface for app ----
ui <- fluidPage(
# App title ----
titlePanel("PAT-R Growth: <school name> Nov2020 - Feb2021"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
sidebarPanel(
# Input: selector for year level
selectInput("year", "Current Year Level",
choices = list("All",
"8",
"9",
"10"),
selected = "All"
),
selectInput("tags", "Current English Class",
choices = "All")
),
#Main panel for displaying outputs-----
mainPanel(
#Output plot ----------------
girafeOutput("growth_plot_test")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
## Render the conditional parts of the UI
observe({
if (input$year == "All") {
updateSelectInput(session, "tags", "Current English Class",
choices = list("All")
)
}
if (input$year == "8") {
updateSelectInput(session, "tags", "Current English Class",
choices = list("All",
"8A",
"8B",
"8C",
"8D",
"8F",
"8G",
"8H",
"8K",
"Lit Support 8")
)
}
if (input$year == "9") {
updateSelectInput(session, "tags", "Current English Class",
choices = list("All",
"9A",
"9B",
"9C",
"9D",
"9E",
"9F",
"9G",
"9H",
"9I",
"Lit Support 9&10")
)
}
if (input$year == "10") {
updateSelectInput(session, "tags", "Current English Class",
choices = list("All",
"10EA01",
"10EA02",
"10EA03",
"10EA04",
"10EA05",
"10EB02",
"Lit Support 9&10")
)
}
})
output$growth_plot_test <- renderGirafe({
year <- switch(input$year,
"All"="All years",
"8"= "Year 8",
"9" = "Year 9",
"10" = "Year 10")
class <- switch(input$tags,
"All"="All classes",
"8A"="08A",
"8B"="08B",
"8C"="08C",
"8D"="08D",
"8F"="08F",
"8G"="08G",
"8H"="08H",
"8K"="8K",
"9A"="09A",
"9B"="09B",
"9C"="09C",
"9D"="09D",
"9E"="09E",
"9F"="09F",
"9G"="09G",
"9H"="09H",
"9I"="09I",
"10EA01"="EA01",
"10EA02"="EA02",
"10EA03"="EA03",
"10EA04"="EA04",
"10EA05"="EA105",
"10EB02"="EB02",
"Lit Support 8"="Lit Support 8",
"Lit Support 9&10"="Lit Support 910"
)
if (input$year=="All") {
growth_plot_all <-
growth_data_years_n %>%
ggplot(aes(yl_two, growth_years))+
theme_classic()+
geom_smooth_interactive(alpha=0.1, colour="grey", se=TRUE)+
geom_jitter_interactive(aes(colour=factor(year_level),
data_id=(year_level),
tooltip=paste0(name.x, ", growth: ", growth_years, ", Year 7 NAPLAN:", band_description)
),
size=point_size, alpha=point_alpha)+
scale_x_continuous(breaks = seq(0,11, by=1))+
geom_hline(yintercept = 0, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 7, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 10, linetype = "dashed", alpha = 0.3)+
labs(x="Approx Year level (March 2021)", y="Approx growth in years", title="PAT-R March 2021, whole school", subtitle="Snapshot of student scores and growth since last test", colour="Year level")
girafe(ggobj = growth_plot_all, width_svg = 7, height_svg = 4, options = list(
opts_hover_inv(css = "opacity:0.1;")))
}
else if (input$year=="8"){
growth_function_8("Year 8", class)
}
else if (input$year=="9"){
growth_function_9("Year 9", class)
}
else if (input$year=="10"){
growth_function_10("Year 10", class)
}
})
}
# Run the application
shinyApp(ui, server)
Here's the r script that contains growth_function_8/9/10':
## Making functions for PAT growth, adding in NAPLAN data when available
##Presets and making required objects
#presets
point_size <- 3
point_alpha <- 0.4
## Read in the longitudinal data & clean
growth_data <- read.csv("data/cc_patr.csv") %>%
row_to_names(3) %>%
clean_names() %>%
unite(name, c(given_name, family_name), sep = " ",remove = FALSE) %>%
rename(scale_one = 11,
scale_two = 15) %>%
mutate(scale_two=as.numeric(scale_two), scale_one=as.numeric(scale_one)) %>%
drop_na()
## Read in the year level conversion chart & clean
scale_to_year <- read.csv("data/patR_range_to_year.csv") %>%
clean_names() %>%
rename(range_start=i_range_start_score)
## Add approx year level via scale_to_year
growth_data_years <- growth_data %>%
mutate(yl_two = map_dbl(scale_two, .f = function(x) {
scale_to_year %>%
filter(x >= range_start, x <= range_end) %>%
pull(range_level)
}
),
yl_one = map_dbl(scale_one, .f = function(x) {
scale_to_year %>%
filter(x >= range_start, x <= range_end) %>%
pull(range_level)
}
),
growth_scale=(scale_two-scale_one),
growth_years=(yl_two-yl_one))
## Add NAPLAN reading bands (years 9 & 10 only)
## Year 9
NAP_scales_9 <- read.csv("data/reading_2019_7_cc.csv") %>%
clean_names() %>%
unite(name, c(first_name, surname), sep = " ",remove = FALSE) %>%
rename(reading = reading_nb, username = cases_id) %>%
mutate(band = case_when(between(reading, -44, 417.1) ~ 4,
between(reading, 417.2, 484.5) ~ 5,
between(reading, 484.6, 534.8) ~ 6,
between(reading, 534.9, 583.7) ~ 7,
between(reading, 583.8, 634.6) ~ 8,
between(reading, 634.7, 1000) ~ 9
)) %>%
mutate(band_description = case_when(
between(band, 4, 5) ~ "Bottom Two Bands",
between(band, 6, 7) ~ "Middle Two Bands",
between(band, 8, 9) ~ "Top Two Bands"))
## Year 10
NAP_scales_10 <- read.csv("data/reading_2018_7_cc.csv") %>%
clean_names() %>%
unite(name, c(first_name, surname), sep = " ",remove = FALSE) %>%
rename(reading = reading_nb, username = cases_id) %>%
mutate(band = case_when(between(reading, -200, 416.7) ~ 4,
between(reading, 416.8, 468.7) ~ 5,
between(reading, 468.8, 523.1) ~ 6,
between(reading, 523.2, 574.2) ~ 7,
between(reading, 574.3, 626.7) ~ 8,
between(reading, 626.8, 1000) ~ 9
)) %>%
mutate(band_description = case_when(
between(band, 4, 5) ~ "Bottom Two Bands",
between(band, 6, 7) ~ "Middle Two Bands",
between(band, 8, 9) ~ "Top Two Bands"))
## Join two NAP tables together
All_NAP <- NAP_scales_10 %>%
bind_rows(NAP_scales_9)
## joining PAT growth to NAPLAN band
growth_data_years_n <- growth_data_years %>%
left_join(All_NAP, by="username")
## Making the function: Year 10
##Answers the question: 'Where are our students at and how have they grown?'
growth_function_10 <-
function(year, class) {
data_wall_10 <-
growth_data_years_n %>%
filter(year_level==year | year=="All years",
tags==class | class=="All classes") %>%
ggplot(aes(yl_two, growth_years))+
theme_classic()+
geom_smooth_interactive(alpha=0.1, colour="grey", se=TRUE)+
geom_jitter_interactive(aes(colour=(factor(band_description)), data_id=(band_description),
tooltip=paste0(name.x, ", growth: ", growth_years,
", Year 7 NAPLAN:", band_description)),
size=point_size, alpha=point_alpha)+
scale_x_continuous(breaks = seq(0,11, by=1))+
geom_hline(yintercept = 0, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 7, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 10, linetype = "dashed", alpha = 0.3)+
labs(x="Approx Year level (March 2021)",
y="Approx growth in years",
title=paste("PAT-R March 2021,", year, class),
subtitle="Snapshot of student scores and growth since previous test",
colour="Year 7 NAPLAN Band")
girafe(ggobj = data_wall_10, width_svg = 7, height_svg = 4, options = list(
opts_hover_inv(css = "opacity:0.1;")))
}
## Year 9
##Answers the question: 'Where are our students at and how have they grown?'
growth_function_9 <-
function(year, class) {
data_wall_9 <-
growth_data_years_n %>%
filter(year_level==year | year=="All years",
tags==class | class=="All classes") %>%
ggplot(aes(yl_two, growth_years))+
theme_classic()+
geom_smooth_interactive(alpha=0.1, colour="grey", se=TRUE)+
geom_jitter_interactive(aes(colour=(factor(band_description)), data_id=(band_description),
tooltip=paste0(name.x, ", growth: ", growth_years,
", Year 7 NAPLAN:", band_description)),
size=point_size, alpha=point_alpha)+
scale_x_continuous(breaks = seq(0,11, by=1))+
geom_hline(yintercept = 0, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 7, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 10, linetype = "dashed", alpha = 0.3)+
labs(x="Approx Year level (March 2021)",
y="Approx growth in years",
title=paste("PAT-R March 2021,", year, class),
subtitle="Snapshot of student scores and growth since previous test",
colour="Year 7 NAPLAN Band")
girafe(ggobj = data_wall_9, width_svg = 7, height_svg = 4, options = list(
opts_hover_inv(css = "opacity:0.1;")))
}
## Making the function: Year 8
##Answers the question: 'Where are our students at and how have they grown?'
growth_function_8 <-
function(year, class) {
data_wall_8 <-
growth_data_years_n %>%
filter(year_level==year | year=="All years",
tags==class | class=="All classes") %>%
ggplot(aes(yl_two, growth_years))+
theme_classic()+
geom_smooth_interactive(alpha=0.1, colour="grey", se=TRUE)+
geom_jitter_interactive(aes(colour=factor(tags), data_id=(tags),
tooltip=paste0(name.x, ", growth: ", growth_years)),
size=point_size, alpha=point_alpha)+
scale_x_continuous(breaks = seq(0,11, by=1))+
geom_hline(yintercept = 0, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 7, linetype = "dashed", alpha = 0.3)+
geom_vline(xintercept = 10, linetype = "dashed", alpha = 0.3)+
labs(x="Approx Year level (March 2021)",
y="Approx growth in years",
title=paste("PAT-R March 2021,", year, class),
subtitle="Snapshot of student scores and growth since previous test",
colour="Class")
girafe(ggobj = data_wall_8, width_svg = 7, height_svg = 4, options = list(
opts_hover_inv(css = "opacity:0.1;")))
}
There's a bit of probably clunky stuff in my code as I'm a beginner but given my previous version launched online I don't think it's the problem.
Here's the logs from shiny. I've checked other posts from people with this same general issue and often the logs provide a hint (sometimes a very loud one) of the problem but I can't get anything from this myself:
2021-07-11T22:37:59.555637+00:00 shinyapps[4286832]: Running on host: 467471711e16
2021-07-11T22:37:59.563606+00:00 shinyapps[4286832]: Server version: 1.8.6.1
2021-07-11T22:37:59.563619+00:00 shinyapps[4286832]: LANG: en_AU.UTF-8
2021-07-11T22:37:59.563620+00:00 shinyapps[4286832]: R version: 4.1.0
2021-07-11T22:37:59.563644+00:00 shinyapps[4286832]: httpuv version: 1.6.1
2021-07-11T22:37:59.563669+00:00 shinyapps[4286832]: rmarkdown version: 2.9
2021-07-11T22:37:59.563636+00:00 shinyapps[4286832]: shiny version: 1.6.0
2021-07-11T22:37:59.563683+00:00 shinyapps[4286832]: knitr version: 1.33
2021-07-11T22:37:59.563717+00:00 shinyapps[4286832]: RJSONIO version: (none)
2021-07-11T22:37:59.563689+00:00 shinyapps[4286832]: jsonlite version: 1.7.2
2021-07-11T22:37:59.563895+00:00 shinyapps[4286832]: Using pandoc: /opt/connect/ext/pandoc/2.11
2021-07-11T22:37:59.563729+00:00 shinyapps[4286832]: htmltools version: 0.5.1.1
2021-07-11T22:37:59.767243+00:00 shinyapps[4286832]: Using jsonlite for JSON processing
2021-07-11T22:37:59.770504+00:00 shinyapps[4286832]:
2021-07-11T22:37:59.770506+00:00 shinyapps[4286832]: Starting R with process ID: '23'
2021-07-11T22:38:00.786814+00:00 shinyapps[4286832]: ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
2021-07-11T22:38:00.792087+00:00 shinyapps[4286832]: ✔ ggplot2 3.3.4 ✔ purrr 0.3.4
2021-07-11T22:38:00.792089+00:00 shinyapps[4286832]: ✔ tibble 3.1.2 ✔ dplyr 1.0.6
2021-07-11T22:38:00.792090+00:00 shinyapps[4286832]: ✔ readr 1.4.0 ✔ forcats 0.5.1
2021-07-11T22:38:00.792090+00:00 shinyapps[4286832]: ✔ tidyr 1.1.3 ✔ stringr 1.4.0
2021-07-11T22:38:00.879246+00:00 shinyapps[4286832]: ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
2021-07-11T22:38:00.895498+00:00 shinyapps[4286832]:
2021-07-11T22:38:00.879249+00:00 shinyapps[4286832]: ✖ dplyr::filter() masks stats::filter()
2021-07-11T22:38:00.879250+00:00 shinyapps[4286832]: ✖ dplyr::lag() masks stats::lag()
2021-07-11T22:38:00.895500+00:00 shinyapps[4286832]: Attaching package: ‘janitor’
2021-07-11T22:38:00.895501+00:00 shinyapps[4286832]:
2021-07-11T22:38:00.896165+00:00 shinyapps[4286832]: The following objects are masked from ‘package:stats’:
2021-07-11T22:38:00.896167+00:00 shinyapps[4286832]:
2021-07-11T22:38:00.971114+00:00 shinyapps[4286832]: Error in value[[3L]](cond) :
2021-07-11T22:38:00.971118+00:00 shinyapps[4286832]: Execution halted
2021-07-11T22:38:00.896168+00:00 shinyapps[4286832]: chisq.test, fisher.test
2021-07-11T22:38:00.971117+00:00 shinyapps[4286832]: Calls: local ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
2021-07-11T22:38:00.896168+00:00 shinyapps[4286832]:
2021-07-11T22:38:13.154676+00:00 shinyapps[4286832]: Running on host: 467471711e16
2021-07-11T22:38:13.162661+00:00 shinyapps[4286832]: Using pandoc: /opt/connect/ext/pandoc/2.11
2021-07-11T22:38:13.162389+00:00 shinyapps[4286832]: Server version: 1.8.6.1
2021-07-11T22:38:13.162485+00:00 shinyapps[4286832]: RJSONIO version: (none)
2021-07-11T22:38:13.162398+00:00 shinyapps[4286832]: LANG: en_AU.UTF-8
2021-07-11T22:38:13.352490+00:00 shinyapps[4286832]: Using jsonlite for JSON processing
2021-07-11T22:38:13.162456+00:00 shinyapps[4286832]: shiny version: 1.6.0
2021-07-11T22:38:13.355629+00:00 shinyapps[4286832]: Starting R with process ID: '41'
2021-07-11T22:38:13.162432+00:00 shinyapps[4286832]: R version: 4.1.0
2021-07-11T22:38:13.355628+00:00 shinyapps[4286832]:
2021-07-11T22:38:13.162470+00:00 shinyapps[4286832]: httpuv version: 1.6.1
2021-07-11T22:38:13.162480+00:00 shinyapps[4286832]: rmarkdown version: 2.9
2021-07-11T22:38:13.162480+00:00 shinyapps[4286832]: knitr version: 1.33
2021-07-11T22:38:13.162481+00:00 shinyapps[4286832]: jsonlite version: 1.7.2
2021-07-11T22:38:13.162510+00:00 shinyapps[4286832]: htmltools version: 0.5.1.1
2021-07-11T22:38:14.360531+00:00 shinyapps[4286832]: ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
2021-07-11T22:38:14.365837+00:00 shinyapps[4286832]: ✔ ggplot2 3.3.4 ✔ purrr 0.3.4
2021-07-11T22:38:14.365838+00:00 shinyapps[4286832]: ✔ tibble 3.1.2 ✔ dplyr 1.0.6
2021-07-11T22:38:14.365839+00:00 shinyapps[4286832]: ✔ tidyr 1.1.3 ✔ stringr 1.4.0
2021-07-11T22:38:14.365839+00:00 shinyapps[4286832]: ✔ readr 1.4.0 ✔ forcats 0.5.1
2021-07-11T22:38:14.451571+00:00 shinyapps[4286832]: ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
2021-07-11T22:38:14.451574+00:00 shinyapps[4286832]: ✖ dplyr::lag() masks stats::lag()
2021-07-11T22:38:14.451573+00:00 shinyapps[4286832]: ✖ dplyr::filter() masks stats::filter()
2021-07-11T22:38:14.467414+00:00 shinyapps[4286832]:
2021-07-11T22:38:14.467416+00:00 shinyapps[4286832]: Attaching package: ‘janitor’
2021-07-11T22:38:14.468071+00:00 shinyapps[4286832]: The following objects are masked from ‘package:stats’:
2021-07-11T22:38:14.468073+00:00 shinyapps[4286832]: chisq.test, fisher.test
2021-07-11T22:38:14.467416+00:00 shinyapps[4286832]:
2021-07-11T22:38:14.542881+00:00 shinyapps[4286832]: Execution halted
2021-07-11T22:38:14.468073+00:00 shinyapps[4286832]:
2021-07-11T22:38:14.468072+00:00 shinyapps[4286832]:
2021-07-11T22:38:14.542881+00:00 shinyapps[4286832]: Calls: local ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
2021-07-11T22:38:14.542879+00:00 shinyapps[4286832]: Error in value[[3L]](cond) :
If anyone can help I'd be eternally grateful (I'm planning on having a team of teachers access this app tomorrow night--eek!)
Alexander