Shiny failed to read column based on selectInput from uploaded csv - r

Problem:
I was trying to build a shiny app that plot frequency of n-grams based on a user specified column from a user uploaded csv. In addition, a function was added to plot the senetiment over time, based on a date column specified by the user as well.
The app was working okay locally, with Warning, but failed work after published. Please see the following for a reproducible example.
Preparation: libraries and example data
# Load R packages
library(shiny)
library(tidyverse)
library(shinythemes)
library(lubridate)
library(tidytext)
library(textdata)
# Creating a example csv file for upload
Sample_csv <-
data.frame(text = janeaustenr::emma,
id = 1:length(janeaustenr::emma),
date = sample(seq(as.Date('1900/01/01'), as.Date('1920/01/01'), by="day"),
replace = T,
length(janeaustenr::emma)))
write.csv(Sample_csv, "Sample_csv.csv", row.names = F)
UI
ui <- fluidPage(theme = shinytheme("united"),
titlePanel("Text glancer"),
sidebarLayout(
sidebarPanel(
# Input: Select a file ----
fileInput("csv_file", "Feed csv here",
multiple = FALSE,
accept = c(".csv")),
#Conditional panel
conditionalPanel(
# use a server side condition
condition = "output$fileUploaded",
# Input: Select ----
uiOutput("text_select"),
# Input: Select ----
uiOutput("date_select"),
# Input: Simple integer interval ----
sliderInput("top_frequency", "Top n ngrams to be plotted:",
min = 5, max = 20, value = 10),
# Input: Select ----
selectInput("ngrams", "Ngrams of your choice:",
c("Single word" = 1,
"Bigram" = 2,
"Trigram" = 3)
)
),
# Submit bottom
submitButton("Update View", icon("refresh"))
),
# sidebarPanel
mainPanel(
tabsetPanel(
tabPanel(h2("Most frequenlty used n-grams"),
plotOutput("frequency_plot", height = 900, width = 1200)),
tabPanel(h2("Sentiment of the months"),
plotOutput("sentiment_plot", height = 900, width = 1200))
)
)
)
)
server
server <- function(input, output, session) {
# create reactive version of the dataset (a data.frame object)
LOAD_DATA <- reactive({
infile <- input$csv_file
if (is.null(infile))
{return(NULL)}
{read_csv(infile$datapath)}
})
# inform conditionalPanel wheter dropdowns sohould be hidden
output$fileUploaded <- reactive({
return(!is.null(LOAD_DATA()))
})
outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
## update 'column' selectors
output$text_select <- renderUI({
if(is.null(LOAD_DATA()))
{return(NULL)}
else
selectInput("text_col", "Select the text column:", colnames(LOAD_DATA()))
})
output$date_select <- renderUI({
if(is.null(LOAD_DATA()))
{return(NULL)}
else
selectInput("date_col", "Select the date column (ymd):", colnames(LOAD_DATA()))
})
# Create reactive parameters
TOP_FREQUENCY <- reactive({
input$top_frequency
})
N_GRAMS <- reactive({
as.numeric(as.character(input$ngrams))
})
# Output frequency of ngrams
output$frequency_plot <- renderPlot( {
if(is.null(LOAD_DATA()))
{return(NULL)}
else{
WORK_DATA <- LOAD_DATA()[,c(input$text_col,
input$date_col)]
names(WORK_DATA) <- c("TEXTS", "DATES")
CSV_DOC_N_Grams <-
WORK_DATA %>%
# LOAD_DATA() %>%
# select(TEXTS = TEXT_COL(), DATES = DATE_COL()) %>%
mutate(TEXTS = gsub("http.*", " ", TEXTS)) %>%
# mutate(text = gsub("\\#.* |\\#.* .|\\#.* ,", " ", text)) %>%
unnest_tokens(words, TEXTS, token = "ngrams", n = N_GRAMS()) %>%
select(words) %>%
filter(str_detect(words, "[a-zA-Z]")) %>%
separate(words, c("word1","word2","word3"),sep = " ", remove = F) %>%
filter(! word1 %in% stop_words$word &
! word2 %in% stop_words$word&
! word3 %in% stop_words$word)
#Counting ngrams
CSV_DOC_N_Gramss_Count <-
CSV_DOC_N_Grams %>%
count(words, sort=T) %>%
select(N_Gram_Text = words,
N_Gram_Count = n)
#Plotting ngram frequency
CSV_DOC_N_Gramss_Count_freq <-
CSV_DOC_N_Gramss_Count %>%
mutate(N_Gram_Text = fct_reorder(N_Gram_Text, N_Gram_Count)) %>%
top_n(TOP_FREQUENCY(), N_Gram_Count) %>%
ggplot(aes(x = N_Gram_Text,
y = N_Gram_Count,
fill = N_Gram_Count)) +
geom_col()+
coord_flip() +
scale_fill_gradient2()+
labs(title = paste0("Top ", TOP_FREQUENCY(), " ngrams used in csv doc"),
x = "ngrams",
y = "frequency") +
theme_bw()+
theme(legend.position = "none",
axis.text.x = element_text(face='bold',size=12),
axis.text.y = element_text(face='bold',size=12),
axis.title.x = element_text(face='bold',size=18),
axis.title.y = element_blank())
print(CSV_DOC_N_Gramss_Count_freq)
}
})
output$sentiment_plot <- renderPlot( {
if(is.null(LOAD_DATA())){return(NULL)}
else{
WORK_DATA <- LOAD_DATA()[,c(input$text_col,
input$date_col)]
names(WORK_DATA) <- c("TEXTS", "DATES")
tk_afinn <-
WORK_DATA %>%
mutate(TEXTS = gsub("http.*", " ", TEXTS)) %>%
unnest_tokens(word, TEXTS) %>%
filter(! word %in% stop_words$word) %>%
filter(str_detect(word, "[a-zA-Z]")) %>%
filter(! DATES %in% NA) %>%
inner_join(get_sentiments("afinn")) %>%
mutate(YEAR_Month = ymd(paste(year(DATES),
month(DATES),
"1", sep="-"))) %>%
group_by(index = YEAR_Month) %>%
summarise(sentiment = sum(value))
tk_afinn_plot <-
tk_afinn %>%
ggplot(aes(x = index, y = sentiment)) +
geom_line()+
labs(x = "date (year-month)",
y = "sentiment of the month") +
theme_bw()+
theme(legend.position = "none",
axis.text.x = element_text(face='bold',size=12),
axis.text.y = element_text(face='bold',size=12),
axis.title.x = element_text(face='bold',size=18),
axis.title.y = element_blank())
print(tk_afinn_plot)
}
})
}
Fuse
shinyApp(ui = ui, server = server)
Warnings:
After loading the csv file, the local app reports :
"Problem with mutate() input TEXTS.
object 'TEXTS' not found
Input TEXTS is gsub("http.*", " ", TEXTS)."
After specify the text column and date column, both tab showed plots. However, after publishing it to shinyapp.io, it reports error and would not run.
Can anybody help with this issue? I have consulted the other thread includin this>https://stackoverflow.com/questions/47248534/dynamically-list-choices-for-selectinput-from-a-user-selected-column, but still no luck.
Any insight would be greatly appreciated!

Related

How to change chart based on toggle checkbox in r shiny?

I am new to shiny and trying to change chart variable based on toggle switch input but getting error.
I have used the toggleid inside the observe({}) but not sure if that's how it is done.
Based on condition I have stored the required variable name in Case_selected which I have tried to use with !!Case_selected to get the variable name out from it.
ui code:
fluidRow(
style = "border: 1px solid gray;",
h3("Top Countries with Confirmed Cases"),
column(3, style = "border: 1px solid gray;",
materialSwitch(
inputId = "id_switch_confirmedtotal",
label = "Death Cases",
value = FALSE,
status = "danger"
),
plotOutput("top_confirmed_total", height = "650px")),
column(3, style = "border: 1px solid gray;",
materialSwitch(
inputId = "id_switch_confirmeddaily",
label = "Death Cases",
value = FALSE,
status = "danger"
),
plotOutput("top_confirmed_daily", height = "650px")),
column(6,
h4("Latest 1 week Top Countries by Daily Confirmed Cases"),
plotOutput("lastweek_confirmed_daily", height = "650px")
)
),
server code:
observe({
x <- input$id_switch_confirmedtotal
# condition tested
if (is.null(x))
Case_selected <- "Confirmed"
else
Case_selected <- "Death"
})
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = !! Case_selected, n = 10) %>% # Confirmed
ggplot(aes( x = !! Case_selected, y = reorder(Country.Region, !! Case_selected),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
#scale_fill_tableau(palette = "Tableau 20")
})
Error: object 'Case_selected' not found
I have also tried with !! rlang::sym() but not sure why none of this is working.
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = !! rlang::sym(Case_selected) , n = 10) %>% # Confirmed
ggplot(aes( x = !! rlang::sym(Case_selected), y = reorder(Country.Region, !! rlang::sym(Case_selected)),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
scale_fill_tableau(palette = "Tableau 20") +
labs(title = "Top10 TotalConfirmed Countries",
subtitle = glue("as of {max(ts_all_long$date)}"),
y = "", x = "Total Confirmed Cases",
caption = "Data source: covid19.analytics
Created by: ViSa")
})
Original Code that works without using any variable toggle option:
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = Confirmed, n = 10) %>%
ggplot(aes( x = Confirmed, y = reorder(Country.Region, Confirmed),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
#scale_fill_tableau(palette = "Tableau 20")
})
Update ts_all_long
Update for reproduce able example:
library(tidyverse)
library(lubridate)
file_url1 <- "https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/ts_all_long4.csv"
ts_all_long <- read.csv(url(file_url1))
ts_all_long <- ts_all_long %>%
mutate(date = as.Date(date))
ui.R
library(shiny)
library(shinydashboard)
library(shinythemes)
library(shinyWidgets)
library(highcharter)
shinyUI(fluidPage(
theme=shinytheme("lumen"),
themeSelector(),
navbarPage(
title = "Covid19 Dashboard",
id = "Covid19_Dashboard",
tabPanel("By Confirmed Cases",
# Application title
titlePanel("Global level"),
# fluidRow(h5("(this Page may take some time, kindly wait to load!!)",
# col = "gray30", align = "center")),
fluidRow(
style = "border: 1px solid gray;",
h3("Top Countries with Confirmed Cases"),
column(3, style = "border: 1px solid gray;",
materialSwitch(
inputId = "id_switch_confirmedtotal",
label = "Death Cases",
value = FALSE,
status = "danger"
),
plotOutput("top_confirmed_total", height = "650px")
)
)
)))
server.R
library(shiny)
library(tidyverse)
library(ggthemes)
library(covid19.analytics)
library(tidytext)
library(scales)
library(lubridate)
library(glue)
library(highcharter)
library(shinyWidgets)
shinyServer(function(input, output) {
observe({
x <- input$id_switch_confirmedtotal
# condition tested
if (is.null(x))
Case_selected <- "Confirmed"
else
Case_selected <- "Death"
})
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = .data[[Case_selected]], n = 10) %>% # Confirmed
ggplot(aes( x = .data[[Case_selected]],
y = reorder(Country.Region, .data[[Case_selected]]),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
scale_fill_tableau(palette = "Tableau 20") +
labs(title = "Top10 TotalConfirmed Countries",
subtitle = glue("as of {max(ts_all_long$date)}"),
y = "", x = "Total Confirmed Cases",
caption = "Data source: covid19.analytics
Created by: ViSa")
})
})
You need to define Case_selected as reactive so that you can use it throughout the app. Also use .data to refer to column name.
shinyServer(function(input, output) {
rv <- reactiveValues()
observe({
x <- input$id_switch_confirmedtotal
# condition tested
if (!x) rv$Case_selected <- "Confirmed"
else rv$Case_selected <- "Death"
})
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = .data[[rv$Case_selected]], n = 10) %>% # Confirmed
ggplot(aes( x = .data[[rv$Case_selected]],
y = reorder(Country.Region, .data[[rv$Case_selected]]),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
scale_fill_tableau(palette = "Tableau 20") +
labs(title = "Top10 TotalConfirmed Countries",
subtitle = glue("as of {max(ts_all_long$date)}"),
y = "", x = "Total Confirmed Cases",
caption = "Data source: covid19.analytics
Created by: ViSa")
})
})

Why does `filter` crash with an input length error in my shiny app?

i am pretty new to programmring but i have to make a shiny app for a university course.
As you can see i webscraped a data table thats presents different bike geometries and i wanted to create a shiny app, where i can compare the geometries with each other. I am quite happy with my progress, but now i got the problem that it always shows me the error: "Error in : Problem with filter() input ..1.
x Input ..1 must be of size 19 or 1, not size 0.
i Input ..1 is !=.... 161: "
I want that its possible in the app to choose one bike and it automatically compares the bike and shows me the 10 most similar bikes.
#table
Canyon <- read_html("https://enduro-mtb.com/canyon-strive-cfr-9-0-ltd-test-2020/")
Rose <- read_html("https://enduro-mtb.com/rose-root-miller-2020-test/")
Ghost <- read_html("https://enduro-mtb.com/ghost-riot-enduro-2021-erster-test/")
Cube <- read_html("https://enduro-mtb.com/cube-stereo-170-sl-29-test-2020/")
Comparison <- tibble(
Geometry = Canyon %>%
html_nodes(".geometry strong") %>%
html_text()%>%
str_trim(),
CanyonStrive = Canyon %>%
html_nodes("td:nth-child(3)") %>%
html_text()%>%
str_trim(),
GhostRiot = Ghost %>%
html_nodes("td:nth-child(3)") %>%
html_text()%>%
str_trim(),
CubeStereo = Cube %>%
html_nodes("td:nth-child(3)") %>%
html_text()%>%
str_trim(),
RoseRootMiller = Rose %>%
html_nodes("td:nth-child(3)") %>%
html_text()%>%
str_trim(),
)
ComparisonTable <- Comparison %>%
mutate_all(~gsub("mm|°|-.*|/.*|\\.", "", .)) %>%
mutate_all(~gsub(",", ".", .)) %>%
mutate_all(type.convert, as.is=TRUE) %>%
gather("Bikes", "value", 2:ncol(Comparison)) %>%
spread(Geometry,value)
Art <- c("Enduro", "Enduro", "AllMountain", "Enduro")
ComparisonTableHallo <- ComparisonTable
ComparisonTableHallo$Art <- Art
# server
server <- function(input, output, session) {
selectedData1 <- reactive({
ComparisonTableHallo %>%
filter(ComparisonTableHallo$Bikes != gsub("[[:space:]]*$","",gsub("- .*",'',input$Bikes)))
})
selectedData2 <- reactive({
selectedData1() %>%
select(1:12) %>%
filter(selectedData1()$Art %in% input$Art)
})
selectedData3 <- reactive({
ComparisonTableHallo %>%
select(1:12) %>%
filter(ComparisonTableHallo$Bikes == gsub("[[:space:]]*$","",gsub("- .*",'',input$Bikes)))
})
selectedData4 <- reactive({
rbind(selectedData3(),selectedData2())
})
selectedData5 <- reactive({
selectedData4() %>%
select(3:11)
})
selectedData6 <- reactive({
as.numeric(knnx.index(selectedData5(), selectedData5()[1, , drop=FALSE], k=2))
})
selectedData7 <- reactive({
selectedData4()[selectedData6(),]
})
selectedData8 <- reactive({
selectedData7() %>%
select(3:11)
})
# Combine the selected variables into a new data frame
output$plot1 <- renderPlotly({
validate(
need(dim(selectedData2())[1]>=2, "Sorry, no ten similar bikes were found.
Please change the input filters."
)
)
plot_ly(
type = 'scatterpolar',
mode = "closest",
fill = 'toself'
) %>%
add_trace(
r = as.matrix(selectedData8()[1,]),
theta = c("Kettenstrebe", "Lenkwinkel","Oberrohr","Radstand","Reach","Sattelrohr","Sitzwinkel","Stack","Steuerrohr",
"Tretlagerabsenkung"),
showlegend = TRUE,
mode = "markers",
name = selectedData7()[1,1]
) %>%
add_trace(
r = as.matrix(selectedData8()[2,]),
theta = c("Kettenstrebe","Lenkwinkel","Oberrohr","Radstand","Reach","Sattelrohr","Sitzwinkel","Stack","Steuerrohr",
"Tretlagerabsenkung"),
showlegend = TRUE,
mode = "markers",
visible="legendonly",
name = selectedData7()[2,1]
) %>%
layout(
polar = list(
radialaxis = list(
visible = T,
range = c(0,100)
)
),
showlegend=TRUE
)
})
}
#shiny app
ui <- fluidPage(navbarPage("Bike Comparison",
tabPanel("Graphic",fluidPage(theme = shinytheme("flatly")),
tags$head(
tags$style(HTML(".shiny-output-error-validation{color: red;}"))),
pageWithSidebar(
headerPanel('Apply filters'),
sidebarPanel(width = 4,
selectInput('Bike', 'Choose a Bike:',paste(ComparisonTableHallo$Bikes)),
checkboxGroupInput(inputId = "Art",
label = 'Art:', choices = c("Enduro" = "Enduro", "AllMountain" = "AllMountain"
),
selected = c("Enduro" = "Enduro","AllMountain" = "AllMountain"),inline=TRUE),
submitButton("Update filters")
),
mainPanel(
column(8, plotlyOutput("plot1", width = 800, height=700),
p("To visualize the graph of the player, click the icon at side of names
in the graphic legend. It is worth noting that graphics will be overlapped.",
style = "font-size:25px")
)
)
)))
)
shinyApp(ui = ui, server = server)
On your UI, your input is named Bike, on your server, you are referring to input$Bikes. Either Bike needs to change to Bikes, or the opposite.
Edit: (elaboration) Your error is telling you that you have a problem with one your arguments to the function filter. Specifically, you're passing an object of length 0 to the function. You are trying to pass the Bike. An empty select input would pass "", so that isn't the problem. "" has length 1. However an input you never assigned would pass NULL. That has length 0.

R Shiny application for comparing two chronologies

I am providing here an executable simple R shiny application to plot two lines based on column names.
library(shiny)
library(reshape2)
library(ggplot2)
library(dplyr)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("moreControls")
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Cross dating", plotOutput("plot1"))
)
)
)
))
server <- shinyServer(function(input, output) {
datasetInput <- data.frame(chrono_A = rnorm(16,0),chrono_B = rnorm(16,0))
row.names(datasetInput) <- c(seq(2000, 2015))
col_names <- colnames(datasetInput)
output$moreControls <- renderUI({
checkboxGroupInput("variable", "Filter Options", col_names)
})
# Plot data
output$plot1 <- renderPlot({
datasetInput_short <- mutate(datasetInput, year = as.numeric(row.names(datasetInput)))
datasetInput_short <- melt(datasetInput_short, id = c("year"))
datasetInput_short <- dplyr::filter(datasetInput_short, variable %in% input$variable)
ggplot(datasetInput_short, aes(x = year, y = value, group = variable, col = variable)) +
geom_line() + theme_bw() + ylim(-3, 3)
})
})
shinyApp(ui = ui, server = server)
I would like to add two features, which would allow me to move the plotted lines in two ways:
By adding a window where I can directly add the final year for the curve (ideally, the current final year would be entered automatically)
By adding two additional buttons (+ and -), and by clicking them I move each line by one year
Please, see the image below:
Any suggestion is highly appreciated.
I reread your description, maybe this might be helpful, though not entirely sure this is what you have in mind.
You can add two textInput widgets and then add filters to your data so that the data displayed for A and B have years less than these values.
In addition, you can have reactiveValues that include an offsets for A and B that increase/decrease when the buttons are pressed. These offsets will change the year column from the filtered data for A and/or B.
server <- shinyServer(function(input, output) {
datasetInput <- data.frame(chrono_A = rnorm(16,0),chrono_B = rnorm(16,0))
row.names(datasetInput) <- c(seq(2000, 2015))
col_names <- colnames(datasetInput)
rv <- reactiveValues(offset_A = 0, offset_B = 0)
observeEvent(input$but_plus_A, {
rv$offset_A <- rv$offset_A + 1
})
observeEvent(input$but_minus_A, {
rv$offset_A <- rv$offset_A - 1
})
observeEvent(input$but_plus_B, {
rv$offset_B <- rv$offset_B + 1
})
observeEvent(input$but_minus_B, {
rv$offset_B <- rv$offset_B - 1
})
datasetInput_short <- reactive({
datasetInput %>%
mutate(year = as.numeric(row.names(.))) %>%
pivot_longer(cols = starts_with("chrono_"), names_to = "variable", values_to = "value") %>%
dplyr::filter(variable %in% input$variable,
(variable == "chrono_A" & year < input$sel_A) | (variable == "chrono_B" & year < input$sel_B)) %>%
mutate(year = if_else(variable == "chrono_A", year + rv$offset_A, year),
year = if_else(variable == "chrono_B", year + rv$offset_B, year))
})
output$moreControls <- renderUI({
list(
checkboxGroupInput("variable", "Filter Options", col_names),
textInput("sel_A", "Year A", 2015),
actionButton("but_plus_A", "", icon = icon("plus")),
actionButton("but_minus_A", "", icon = icon("minus")),
textInput("sel_B", "Year B", 2015),
actionButton("but_plus_B", "", icon = icon("plus")),
actionButton("but_minus_B", "", icon = icon("minus"))
)
})
# Plot data
output$plot1 <- renderPlot({
ggplot(datasetInput_short(), aes(x = year, y = value, group = variable, col = variable)) +
geom_line() + theme_bw() + ylim(-3, 3)
})
})
Edit:
Based on OP comment below, say you do not know the column names, but there are always 2 columns to work with, you can do the following. You can use the column names vector col_names when filtering.
datasetInput_short <- reactive({
datasetInput %>%
mutate(year = as.numeric(row.names(.))) %>%
pivot_longer(cols = all_of(col_names), names_to = "variable", values_to = "value") %>%
dplyr::filter(variable %in% input$variable,
(variable == col_names[1] & year < input$sel_A) | (variable == col_names[2] & year < input$sel_B)) %>%
mutate(year = if_else(variable == col_names[1], year + rv$offset_A, year),
year = if_else(variable == col_names[2], year + rv$offset_B, year))
})
It is possible to dynamically generate more than 2 sets of inputs (for example, using 3: A, B, and C) but that would be a bit more complex.

ggplot stat_ecdf() with a Shiny reactive expression

I'm hoping to implement this ggplotly bug fix offered here:
https://community.plot.ly/t/bug-with-ggplot2-stat-ecdf-function/1187/4
into a Shiny reactive expression. The top plot below shows the ggplot() call results within Shiny (as expected), the bottom is from ggplotly().
When I try to insert data <- data[order(data$val), ] inside the reactive expression, I'm unable to subset as suggested by the fix: Error in data$val : object of type 'closure' is not subsettable and I can't seem to find any other place for it to work.
reproducible app.r:
library(tidyverse)
library(shiny)
library(shinydashboard)
library(plotly)
# generate sample p & t observation data
zone <- c(rep("a", 6), rep("b", 6), rep("c", 6), rep("d", 6))
set.seed(1)
val <- rnorm(24, 12, 18)
param <- rep(c("p", "t"), 12)
p_t <- data.frame(zone, val, param, stringsAsFactors = FALSE)
# sample elevation frequency data - too many obs to uncount all at once
set.seed(2)
val <- sample(50, 24)
count <- sample(200000, 24)
e_countcsv <- data.frame(zone, val, count, stringsAsFactors = FALSE) %>%
mutate(param = "elev")
shinyApp(
ui = fluidPage(
sidebarLayout(sidebarPanel(
selectizeInput(
"zone", "zone", choices = unique(p_t$zone),
selected = c("a"),
multiple = TRUE),
checkboxGroupInput("param", "parameter",
choices = c("elev", "p", "t"), selected =c("elev", "p"))
),
mainPanel(
tabsetPanel(position=c("right"),
tabPanel(strong("static cdf"),
br(),
plotOutput("reg_plot", height = "750px")) ,
tabPanel(strong("interactive cdf"),
br(),
plotlyOutput("plotlyPlot", height = "750px")) )))
),
server = function(input, output) {
data <- reactive({
p_t %>%
filter(param %in% input$param,
zone %in% input$zone) %>%
bind_rows({e_countcsv %>%
filter(param %in% input$param,
zone %in% input$zone) %>%
uncount(count)})
})
output$reg_plot <- renderPlot({
ggplot(data(), aes(val, color = param, linetype = zone)) +
labs(y = "proportion of total", x = NULL) +
stat_ecdf(pad = FALSE) + coord_flip()
})
output$plotlyPlot <- renderPlotly({
p <- ggplot(data(), aes(val, color = param, linetype = zone)) +
labs(y = "proportion of total", x = NULL) +
stat_ecdf(pad = FALSE) + coord_flip()
p <- ggplotly(p)
p
})
}
)
Any ideas? Thank you!
Like #MrGumble suggested you should not use data as a name because it points to a function (try to print data in your console and you will see the function).
Just give your dataset in the reactive expression another name and it will work:
data <- reactive({
dataset <- p_t %>%
filter(param %in% input$param,
zone %in% input$zone) %>%
bind_rows({e_countcsv %>%
filter(param %in% input$param,
zone %in% input$zone) %>%
uncount(count)})
dataset[order(dataset$val), ]
})

"Warning: Error in eval: could not convert n to scalar integer"

I'm trying to make a shiny app that can let you choose different statistical methods to analyze some insurance data and then plot the results in a certain way. I want to be able to select a few values in the interface and the names of methods, and then have one button to trigger the creation of the model, and then another button to trigger the plot creation.
I'm pretty new to Shiny App and I'm getting an error message that I just cannot figure out.
"Warning: Error in eval: could not convert n to scalar integer"
Here is my code:
library(shiny)
library(insuranceData)
library(caret)
library(randomForest)
library(dplyr)
library(ggplot2)
library(pls)
data(AutoBi)
ui <- fluidPage(
# Application title
titlePanel("Ratemaking Tool"),
#fileInput("file", "Upload file"),
actionButton("do", "Make Model"),
actionButton("Go", "Make Graph"),
selectInput("Model", "Model", c("lm", "glm", "pls")),
sidebarLayout(
sidebarPanel(
sliderInput("percentiles",
"Percentile Splits:",
min = 1,
max = 20,
value = 5,round = TRUE),
sliderInput("cv_splits",
"Folds for K-fold validation:",
min = 1,
max = 10,
value = 5,round = TRUE)),mainPanel(plotOutput("distPlot")
)
)
)
server <- function(input, output){
values <- reactiveValues(df_data = NULL)
observeEvent(input$do, {
dataInput <- isolate(reactive({
t <- AutoBi %>% na.omit() %>% mutate(log.age = log(CLMAGE + 1),log.loss = log(LOSS + 1))
train = slice(t,1:700)
test = slice(t,701:nrow(t)) %>% mutate(log.age = log(CLMAGE + 1),log.loss = log(LOSS + 1))
t1 <- select(train,-c(log.loss,LOSS,CLMAGE))
ctrl <- isolate(trainControl(method = "cv",number = input$cv_splits))
model <- train(x = t1[,c(2,3,4,5,6,7)],y = train$LOSS,trControl = ctrl,
method = input$Model)
preds <- predict(model,test[,c(2,3,4,5,6,9)])
test$pred <- preds
ordered <- test %>% arrange(pred) %>% mutate(quantile = ntile(pred,input$percentiles)) %>% group_by(quantile) %>%
summarize(avg_loss = mean(LOSS),avg_prd= mean(pred)) %>% mutate(flag = as.factor(ifelse(avg_loss - avg_prd > 0,0,1)))
values$df_data = ordered
return(ordered)
}))
values$df_data = dataInput()
})
observeEvent(input$Go,{
output$distPlot <- isolate(renderPlot({
ggplot(values$df_data)+ aes(quantile,avg_loss,size = 1) + geom_point() + geom_point(aes(y = avg_prd,color = "avg_pred")) + ggtitle(paste("Statistical Learning Technique:", input$Model)) +
geom_linerange(aes(ymin = avg_prd,ymax = avg_loss,size = .1,color = flag)) + guides(size=FALSE)
}))
})
}
shinyApp(ui = ui, server = server)

Resources