Reactive contents problem in for loops for R Shiny - r

I am working on "for loops" in RShiny, I want to plot its result according to selected date. However, I have difficulty in determining reactive contents in server. It didn't worked. Here is my complete code:
dat <- read.csv('C:/Users/10109/Desktop/Alarm/alarm_plant5.CSV',header=T, sep=";")
dat=subset(dat, select = c("SourceName","EventTime" ,"Date"))
dat$Date <- format(as.Date(dat$Date, format = "%m.%d.%Y"), "%Y-%m-%d")
dat$EventTime= paste(dat$Date, dat$Time, sep=" ")
dat$EventTime=as.POSIXct(strptime( dat$EventTime, "%Y-%m-%d %H:%M"), tz = "", origin = '1970-01-01 00:00')
ui <- fluidPage(
titlePanel("Analiz"),
dateRangeInput(inputId="daterange", label = "Tarih" , start = "2017-01-02", end = "2017-12-31", min = "2017-01-02",
max = "2017-12-31", separator = " to "),
verbatimTextOutput("alarmsayisi"),
plotOutput(outputId = "floodplot")
)
server <- function(input, output){
training=reactive({dat%>% filter(as.Date(dat$Date)>=as.Date(input$daterange[1]) & as.Date(dat$Date)<=as.Date(input$daterange[2]) )})
t=0
result=reactive(data.frame())
for (i in seq(reactive(nrow(training())))){
limit2=reactive(training()$EventTime[i]+ minutes(10))
flood_test=reactive(training()%>% filter(training()$EventTime[i] <= training()$EventTime & training()$EventTime <= limit2()))
alarm_number=reactive(nrow(flood_test()))
t=t+1
result[t,1]=reactive(i)
result[t,2]=reactive(input[[training()$EventTime[i]]])
result[t,3]=reactive(input[[alarm_number()]])
}
result()=result()[!duplicated(result()$V2),]
output$floodplot <- renderPlot({
plot(result()$V2, result()$V3, type="l", col= "blue", xlab = "Tarih zaman", ylab = "On dakika icinde calan alarm sayisi",
main = "Alarm flood tahmini")
abline(h=10, col="red", lwd=1.5)
} )
output$alarmsayisi <- renderText({
paste("Toplam alarm sayisi", as.character(nrow(training())))
})
}
shinyApp(ui = ui, server = server)
The errors I encountered are:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Or
Error in result()[t, 1] = i : invalid (NULL) left side of assignment
I did many trials by changing the variables to reactive or not, but I could not make it work. Could you please help me about this issue? There should be something I interpret wrong.

Related

Shiny Dashboard Date Slider Input

I am new to R and Shiny and have a problem that I have not been able to solve for hours.
I have a dataset from which I display the daily consumption of coffee on a dashboard, which works very well. The plot is a ggplot geom_line chart.
But now I want to be able to change the time period with two sliders.
The sliders I have also managed to do, but the plot does not change when the slider is moved.
I also suspect that I have an error with the date format.
What am I doing wrong?
Thanks for the help
RawData Dataset
library(shiny)
library(dplyr)
library(data.table)
library(ggplot2)
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Coffee consumption"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2018-01-22","%Y-%m-%d"),
max = as.Date("2020-04-04","%Y-%m-%d"),
value= c(as.Date("2018-01-22","%Y-%m-%d"),as.Date("2020-04-04","%Y-%m-%d")),
timeFormat="%Y-%m-%d")
),
mainPanel(
plotOutput("plot_daycount"),
tableOutput("structure"),
tableOutput("rawdata"),
tableOutput("dayconsumption"))
)
)
)
# RawData import
coffeedata = fread("C:/temp/ProductList.csv")
setDF(coffeedata)
coffeedata$Date = as.Date(coffeedata$Date, "%d.%m.%Y")
# Products a day counter
countcoffee <- function(timeStamps) {
Dates <- as.Date(strftime(coffeedata$Date, "%Y-%m-%d"))
allDates <- seq(from = min(Dates), to = max(Dates), by = "day")
coffee.count <- sapply(allDates, FUN = function(X) sum(Dates == X))
data.frame(day = allDates, coffee.count = coffee.count)}
# Making a DF with day consumption
daylicounter = countcoffee(df$coffee.date)
server <- shinyServer(function(input, output) {
output$structure = renderPrint({
str(coffeedata)
})
# Raw Data
output$rawdata = renderTable({
head(coffeedata)
})
output$dayconsumption = renderTable({
head(daylicounter)
})
# GGPLOT2
output$plot_daycount = renderPlot({
DatesMerge = input$DatesMerge
ggplot(daylicounter[daylicounter == DatesMerge], aes(daylicounter$day, daylicounter$coffee.count)) +
geom_line(color = "orange", size = 1)
scale_x_date(breaks = "3 month",
date_labels = "%d-%m-%Y")
# Try outs
# ggplot(daylicounter[month(day) == month(DatesMerge)], mapping = aes(day = day)) +
# geom_line(color = "orange", size = 1)
# scale_x_date(breaks = "3 month",
# date_labels = "%d-%m-%Y")
})
})
shinyApp(ui, server)
I appreciate your help
As noted by #Kevin, you need to use input$DatesMerge[1] and input$DatesMerge[2] when subsetting your data. For clarity, this can be done in a separate step. Try something like this in your server:
output$plot_daycount = renderPlot({
DatesMerge <- as.Date(input$DatesMerge, format = "%Y-%m-%d")
sub_data <- subset(daylicounter, day >= DatesMerge[1] & day <= DatesMerge[2])
ggplot(sub_data, aes(x = day, y = coffee.count)) +
geom_line(color = "orange", size = 1) +
scale_x_date(breaks = "3 month", date_labels = "%d-%m-%Y")
})
Edit Additional question from OP was asked:
Why does my date format look normal with str(coffeedata) but with
head(coffeedata) the date is just a number?
renderTable uses xtable which may have trouble with dates. You can get your dates to display correctly by converting to character first (one option):
output$rawdata = renderTable({
coffeedata$Date <- as.character(coffeedata$Date)
head(coffeedata)
})
output$dayconsumption = renderTable({
daylicounter$day <- as.character(daylicounter$day)
head(daylicounter)
})
See other questions on this topic:
as.Date returns number when working with Shiny
R shiny different output between renderTable and renderDataTable
Welcome to R and Shiny, you are off to a great start. Few things:
I don't recommend you using = in shiny, majority of the cases you want to use <-
To simplify code, no reason to add a variable like DatesMerge. It adds no value (at least in the code above)
For a dual slider, you need to tell shiny which end to pick. input$DatesMerge doesn't mean anything but input$DatesMerge[1] does.
When asking for help, it is always better to add a subset of data within the code itself. You tend to get more help and it is easier to run for the person trying to help (like me I was too lazy to download the file and place it in a folder so I didn't run it)
You need to account for a range of dates in your slider when subsetting the data; you also for the , when subsetting the data.
ggplot(daylicounter[daylicounter %in% input$DatesMerge[1]:input$DatesMerge[2],], aes(daylicounter$day, daylicounter$coffee.count)) +
geom_line(color = "orange", size = 1) +
scale_x_date(breaks = "3 month",
date_labels = "%d-%m-%Y")

Invoke function within RShiny server call and render result as print output

I have written a script which makes use of 2 functions in order to calculate the duration required for a test to run, eg power analysis.
Inputs and code as follows;
## RUN POWER CALCULATION
average_daily_traffic <- 3515/30
control <- 0.47
uplift <- 0.02
num_vars <- 2
sample_size_calculator <- function(control, uplift){
variant <- (uplift + 1) * control
baseline <- ES.h(control, variant)
sample_size_output <- pwr.p.test(h = baseline,
n = ,
sig.level = 0.05,
power = 0.8)
if(variant >= 0)
{return(sample_size_output)}
else
{paste("N/A")}
}
## RUN DAYS CALCULATOR FUNCTION
days_calculator <- function(sample_size_output, average_daily_traffic){
days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
if(days_required >= 0)
{paste0("It will take ", round(days_required, digits = 0)*num_vars, " days for this test to reach significance, with a daily average of " , round(average_daily_traffic, digits = 0), " visitors to this page over a 30 day period.")}
else
{paste("N/A")}
}
## RUN FUNCTIONS AND OUTPUT ANSWER
sample_size_calculator <- sample_size_calculator(control, uplift)
sample_size_output <- sample_size_calculator$n
answer <- days_calculator(sample_size_output, average_daily_traffic)
answer
This code is performant and is fit for my purpose in a standalone R script.
However, I need to make these functions executable from within a Shiny app. My attempt is as follows;
library(shiny)
ui <- fluidPage(
actionButton("exe", "Run",
style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
mainPanel(
textOutput("answer")
))
server <- function(input, output, session) {
sample_size_calculator <- eventReactive(input$exe,{
average_daily_traffic <- 3515/30
control <- 0.47
uplift <- 0.02
num_vars <- 2
variant <- (uplift + 1) * control
baseline <- ES.h(control, variant)
sample_size_output <- pwr.p.test(h = baseline,
n = ,
sig.level = 0.05,
power = 0.8)
if(variant >= 0)
{return(sample_size_output)}
else
{paste("N/A")}
})
days_calculator <- eventReactive (input$exe,{
days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
if(days_required >= 0)
{paste0("It will take approximately ", round(days_required, digits = 0)*num_vars, " days or ", round((round(days_required, digits = 0)*num_vars)/365, digits = 1) ," years for this test to reach significance, based on a daily average of " , round(average_daily_traffic, digits = 0), " users to this page in the last 30 days.")}
else
{paste("N/A")}
})
outputs_ <- eventReactive( input$exe, {
req(sample_size_calculator())
req(days_calculator())
sample_size_calculator <- sample_size_calculator(control, uplift)
sample_size_output <- sample_size_calculator$n
answer <- days_calculator(sample_size_output, average_daily_traffic)
output$answer <- renderText(outputs_$answer)
})
}
shinyApp(ui = ui, server = server)
When I run this code, I see the execute button but no output is displayed.
This is very likely due to a limitation in my understanding of how Shiny invokes functions so if there is a better way I would be very grateful to hear it.
Thanks in advance.
* EDITING TO INCLUDE FULL FUNCTIONALITY CODE *
The objective of the code is to use Mark Edmonson's googleAnalyticsR and googleAuthR to enable retrieval of web visit data to a particular URL/page from the Google Analytics account for last 30days and show a trend of this data. This works fine, once the user enters the URL and hits 'Run'.
There is an additional GA call which retrieves additional data for a particular conversion action (see other_data). This is required in order to derive the conversion rate that is used later in the power calculation.
The calculation is cvr <- aeng$users/totalusers
#options(shiny.port = 1221)
## REQUIRED LIBS
library(shiny)
library(googleAnalyticsR)
library(plotly)
library(googleAuthR)
library(markdown)
library(pwr)
gar_set_client(scopes = c("https://www.googleapis.com/auth/analytics.readonly"))
daterange <- function(x) {
as.Date(format(x, "%Y-%m-01"))
}
## DATE PARAMETERS
date_start <- as.Date(Sys.Date(),format='%d-%B-%Y')-31
date_end <- as.Date(Sys.Date(),format='%d-%B-%Y')-1
date_range <- c(date_start, date_end)
## UI SECTION
ui <- fluidPage(
googleAuth_jsUI("auth"),
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "dur_calc.css")
),
tags$br(),
sidebarLayout(
sidebarPanel(
code("To begin, select from 'Accounts' and enter URL of page to be tested:"),
tags$p(),
column(width = 12, authDropdownUI("auth_dropdown",
inColumns = FALSE)),
textInput("url", label = h5(strong("Page to be tested")), value = "Enter full page URL..."),
hr(),
fluidRow(column(3, verbatimTextOutput("value")
)
),
actionButton("exe", "Run Calculator",
style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
),
mainPanel(
plotlyOutput("trend_plot"),
textOutput("page"),
textOutput("answer")
)
)
)
## SERVER SECTION
server <- function(input, output, session) {
auth <- callModule(googleAuth_js, "auth")
## GET GA ACCOUNTS
ga_accounts <- reactive({
req(auth()
)
with_shiny(
ga_account_list,
shiny_access_token = auth()
)
})
view_id <- callModule(authDropdown, "auth_dropdown",
ga.table = ga_accounts)
ga_data <- eventReactive( input$exe, {
x <- input$url
#reactive expression
output$page <- renderText({
paste("You have selected the page:", input$url) })
filterPageurl <- dim_filter("dimension97" , "REGEX", x ,not = FALSE)
filts <- filter_clause_ga4(list( filterPageurl))
req(view_id())
req(date_range)
with_shiny(
google_analytics,
view_id(),
date_range = date_range,
dimensions = "date",
metrics = "users",
dim_filters = filts,
max = -1,
shiny_access_token = auth()
)
})
other_data <- eventReactive( input$exe, {
x <- input$url
filterPageurl <- dim_filter("dimension97" , "REGEX", x ,not = FALSE)
filts <- filter_clause_ga4(list( filterPageurl))
seg_id <- "gaid::uzKGvjpFS_Oa2IRh6m3ACg" #AEUs
seg_obj <- segment_ga4("AEUs", segment_id = seg_id)
req(view_id())
req(date_range)
#req(filts)
with_shiny(
google_analytics,
view_id(),
date_range = date_range,
dimensions = "date",
metrics = "users",
dim_filters = filts,
segments = seg_obj,
max = -1,
shiny_access_token = auth()
)
})
outputly <- eventReactive( input$exe, {
req(other_data())
req(ga_data())
aeng <- other_data()
ga_data <- ga_data()
totalusers <<- sum(ga_data$users)
cvr <- aeng$users/totalusers
average_daily_traffic <- totalusers/30
control <- cvr
uplift <- 0.02
num_vars <- 2
})
sample_size_calculator <- eventReactive(input$exe,{
variant <- (uplift + 1) * control
baseline <- ES.h(control, variant)
sample_size_output <- pwr.p.test(h = baseline,
n = ,
sig.level = 0.05,
power = 0.8)
if(variant >= 0)
{return(sample_size_output)}
else
{paste("N/A")}
})
days_calculator <- eventReactive (input$exe,{
days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
if(days_required >= 0)
{paste0("It will take approximately ", round(days_required, digits = 0)*num_vars, " days or ", round((round(days_required, digits = 0)*num_vars)/365, digits = 1) ," years for this test to reach significance, based on a daily average of " , round(average_daily_traffic, digits = 0), " users to this page in the last 30 days.")}
else
{paste("N/A")}
})
output$trend_plot <- renderPlotly({
req(ga_data())
ga_data <- ga_data()
plot_ly(
x = ga_data$date,
y = ga_data$users,
type = 'scatter',
mode = 'lines') %>%
layout(title = "Page Visitors by Day (last 30 days)",
xaxis=list(title="Date", tickformat='%Y-%m-%d', showgrid=FALSE, showline=TRUE),
yaxis=list(title = "Users", showgrid=FALSE, showline=TRUE)
)
})
calc_answer <- eventReactive(input$exe, {
req(outputly)
outputly <- outputly()
sample_size_calculator <- sample_size_calculator()
sample_size_output <- sample_size_calculator$n
days_calculator(sample_size_output, average_daily_traffic)
})
output$answer <- renderText(calc_answer())
}
shinyApp(ui = ui, server = server)
A few suggestions that may help.
Would start with a simplified shiny app before adding all of the calculations, may be easier to work with for now
Would avoid putting output statements inside of eventReactive. See below for example.
Consider having only one observeEvent or eventReactive for the button press instead of multiple, especially since some function results depend on others.
Right now there are no inputs, so don't need additional reactive expressions. When you add inputs, though, you probably will.
If you haven't already, review the R Studio Shiny tutorial on Action Buttons and Reactivity.
Hope this is helpful in moving forward.
library(shiny)
library(pwr)
ui <- fluidPage(
actionButton("exe", "Run", style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
mainPanel(
textOutput("answer")
)
)
server <- function(input, output, session) {
average_daily_traffic <- 3515/30
control <- 0.47
uplift <- 0.02
num_vars <- 2
sample_size_calculator <- function() {
variant <- (uplift + 1) * control
baseline <- ES.h(control, variant)
sample_size_output <- pwr.p.test(h = baseline,
n = ,
sig.level = 0.05,
power = 0.8)
if(variant >= 0)
{return(sample_size_output)}
else
{return(NA)}
}
days_calculator <- function (sample_size_output, average_daily_traffic) {
days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
if(days_required >= 0)
{paste0("It will take approximately ", round(days_required, digits = 0)*num_vars, " days or ", round((round(days_required, digits = 0)*num_vars)/365, digits = 1) ," years for this test to reach significance, based on a daily average of " , round(average_daily_traffic, digits = 0), " users to this page in the last 30 days.")}
else
{paste("N/A")}
}
calc_answer <- eventReactive(input$exe, {
sample_size_calculator <- sample_size_calculator()
sample_size_output <- sample_size_calculator$n
days_calculator(sample_size_output, average_daily_traffic)
})
output$answer <- renderText(calc_answer())
}
shinyApp(ui = ui, server = server)

Warning: Error in aggregate.data.frame: arguments must have same length Stack trace (innermost first)

I have an r assignment. I am making an interactive plot for a sports team and when I try to calculate the average of the scored goals I keep getting the same error (Error in aggregate.data.frame: arguments must have same length
Stack trace (innermost first)). i tried making the tp variable as data frame and I tried using the tapply function instead of the aggregate but I kept getting the same error.
this is my UI part
library(plotly)
library(ggplot2)
library(plotrix)
ui <- fluidPage(
fluidRow(
column ( width = 3,
h4(span(tagList(icon("filter")), "Select team")),
selectizeInput('team', "", choices = shots$TeamName, selected = TRUE),
br(),
h4(span(tagList(icon("filter")), "Select season")),
selectizeInput('season', "", choices = shots$SeasonNr, selected = TRUE),
br()
)),
plotlyOudataut("pos1")
)
and my server part is:
server <- function(input,oudataut, session){
observeEvent(c(input$team), {
team1 <- input$team
SeasonTx <- input$season
tp <- sqldf(sprintf("select Fullname, Percentage, ShotType, ShotsMade, ShotsNumber, TrainingDate, Position from shots where TeamName is '%s'", team1, "AND SeasonText is '%s'", SeasonTx))
percentageColumn<- aggregate(tp[,4:5], list(tp$TeamName, tp$Position), sum)
percentageColumn$average <- ((percentageColumn$ShotsMade/percentageColumn$ShotsNumber)*100)
colnames(percentageColumn) <- c("Team", "Position", "ShotsMade", "ShotsNumber", "Average")
oudataut$pos1 <-renderPlotly({
plot_ly(x = ~percentageColumn$Position, y = ~percentageColumn$Average, type = 'scatter', mode = 'lines')%>%
layout(title = 'The Average score of the whole team per position',
xaxis = list(title = 'position',dtick=1),
yaxis = list (title = 'Percentage'),xasis=position)
}]
})}
shinyApp(ui, server)
can anyone see the mistake ?
thanks in advance

r - App failed to start - could not find function "setInternet2"

I met some problems that whenever I tried to deploy my shiny applications, I got this message: Error in value[3L] : could not find function setInternet2
Calls: local...tryCatch ......
Execution halted
setInternet2
code here
### install packages
library(doParallel)
library(devtools)
library(lattice)
library(shiny)
library(stringr)
library(lubridate)
library(shinyBS)
library(doSNOW)
library(XML)
library(httr)
library(RCurl)
library(wordcloud)
library(tm)
library(rJava)
library(qdap)
library(slam)
runApp(list(
server = shinyServer(function(input, output, session){
observeEvent(input$getNews, {
output$News <- renderDataTable({
# Create a Progress object
progress <- shiny::Progress$new(session, min=1, max=15)
progress$set(message = "(╯ ̄▽ ̄)╯ Loading...", value = 0)
# Close the progress when this reactive exits (even if there's an error)
on.exit(progress$close())
data <- list()
tmp <- paste('.html', sep='')
url <- paste('https://www.ptt.cc/bbs/Stock/index', tmp, sep='')
html <- httr:::content(GET(url), encoding = "UTF-8") # xml2
html <- XML::xmlParse(html) # parse from xml2 to xml
url.list <- xpathSApply(html, "//div[#class='title']/a[#href]", xmlAttrs)
data <- rbind(data, paste('https://www.ptt.cc', url.list, sep=''))
data <- unlist(data)
# cl = makeCluster(rep('localhost', 8), 'SOCK')
# clusterSetupRNG(cl)
# clusterEvalQ(cl, source('R/R/GET.R'))
getDoc <- function(line){
start <- regexpr('www', line)[1]
end <- regexpr('html', line)[1]
if(start != -1 & end != -1){
url <- substr(line, start, end + 3)
name <- strsplit(url, '/')[[1]][4]
txtName <- gsub('html', 'txt', name)
if(!file.exists(paste0("document/news/", txtName))){
# html <- httr:::content(GET(url, config = set_cookies("over18"="1")), encoding="UTF-8")
html <- httr:::content(GET(url), encoding = "UTF-8")
html <- XML::xmlParse(html)
doc <- xpathSApply(html, "//div[#id='main-content']", xmlValue)
#write(doc, paste0("document/news/", gsub('html', 'txt', name)),
# encoding = "UTF-8")
writeLines(as.character(doc), paste0("document/news/", gsub('html', 'txt', name)),
useBytes=T)
}
}
}
# parSapply(cl, data, getDoc)
# stopCluster(cl)
sapply(data, getDoc)
cl <- makeCluster(4, type = "SOCK")
doSNOW:::registerDoSNOW(cl)
articles <-
foreach(i = 1:length(list.files("document/news/")), .combine = 'c') %dopar% {
readLines(paste0("document/news/", list.files("document/news/")[i]), encoding = "UTF-8")[1]
}
stopCluster(cl)
start = regexpr("新聞", articles)
end = regexpr("2016", articles)
news <- substr(articles, start = start - 1, stop = end + 3)[start != -1]
news
news2 <- substr(news, start = 1, stop = regexpr("時間", news) - 1)
# for messages
Sys.setenv(LANG = "Zh_TW")
Sys.setlocale("LC_ALL", "cht")
start = regexpr("時間", news)
end = regexpr("2016", news)
newsDate = substr(news, start = start + 6, stop = end + 3)
newsDate
Sys.setenv(LANG = "en")
Sys.setlocale("LC_ALL", "English")
newsDate = strptime(newsDate, format = "%b %d %H:%M:%S %Y")
newsDate = as.POSIXct(newsDate)
#newsDate = as.Date(newsDate, format = "%b %d %Y")
Sys.setenv(LANG = "Zh_TW")
Sys.setlocale("LC_ALL", "cht")
newsDF <- data.frame(Date = newsDate, Event = news2)
news <- newsDF
news <- news[order(news$Date, decreasing = TRUE), ]
news[as.Date(news$Date, format = "%b %d %Y") >= input$dateRange[1] &
as.Date(news$Date, format = "%b %d %Y") <= input$dateRange[2], ]
})
})
}),
ui = shinyUI(tagList(
tags$head(tags$script(HTML("Shiny.addCustomMessageHandler('closeWindow', function(m) {window.close();});"))),
navbarPage(
"MynavbarPage", inverse = TRUE, id = "navbar",
tabPanel("News",
sidebarLayout(
sidebarPanel(
width = 3,
bsTooltip("stocks", title = "Please enter stock code from yahoo finance.", placement = "bottom", trigger = "hover", options = NULL),
textInput("stocks", label = "Stock Code", value = "2330.TW"),
bsTooltip("dateRange", title = "This is a time period you apply WFA to.", placement = "bottom", trigger = "hover", options = NULL),
dateRangeInput("dateRange", label = "Choose Period", start = "2015-01-01", end = Sys.Date()),
actionButton("getNews", "Start", class="btn-primary btn-lg")
),
mainPanel(
bootstrapPage(
dataTableOutput("News"))
)
))
)))
))
But I can run my App locally. I was wondering if it had anything to do with my local path settings? My app is in a folder, e.g., "MyAPP" where ui.R and server.R are included. I also have another folder named "document" inside MyAPP. I used lots of list.file("document/").
I didn't include setInternet2 function in my app but I was using web APIs such as httr, XML, tm, etc.
Any suggestions?
Many thanks.
It seems that the following command connects to the internet and downloads the data. And internally it is setting the Internet options
html <- httr:::content(GET(url), encoding = "UTF-8") # xml2
Can you try the following which will help you debug
Instead of downloading the HTMl from the internet, read from a file
If it works then we know for sure that code that fetches data from the internet is the issue
Regards,
Anant

Error with dates and reactive inputs in R Shiny

I am putting together a small R Shiny app which will take several inputs from the user and use these inputs to subset a data frame and provide back two histograms. The users will pick a baseball season, two teams and then this information will provide a reactive list of possible games played between these two teams. The user will then pick a date/game and then a histogram will be displayed for each team which will show the distribution of runs scored per game for each team for all games within that season up to the date/game selected. I feel like I am almost there, I just need to get this date thing sorted out. Right now with the code as is, everything evaluates but I get this error twice;
Warning: Error in eval: do not know how to convert 'input$dates' to class “Date”
and this error twice;
Warning in eval(substitute(expr), envir, enclos) :
Incompatible methods ("Ops.factor", "Ops.Date") for "<"
ui.R
library(shiny)
library(dplyr)
shinyUI(fluidPage(
# Application title
titlePanel("Predicting the winner of a Major League Baseball game"),
sidebarLayout(
sidebarPanel(
selectInput("season","1. Select an MLB Season",
choices = list(2012,2013,2014,2015),
selected = 2012),
selectInput("var_1","2. Select the first team",
choices = c("ARI","ATL","BAL","BOS","CHC","CHW","CIN","CLE","COL","DET",
"HOU","KCR","LAA","LAD","MIA","MIL","MIN","NYM","NYY","OAK",
"PHI","PIT","SDP","SFG","SEA","STL","TBR","TEX","TOR","WSN"),
selected = "BAL"),
selectInput("var_2","3. Select the second team",
choices = c("ARI","ATL","BAL","BOS","CHC","CHW","CIN","CLE","COL","DET",
"HOU","KCR","LAA","LAD","MIA","MIL","MIN","NYM","NYY","OAK",
"PHI","PIT","SDP","SFG","SEA","STL","TBR","TEX","TOR","WSN"),
selected = "BOS"),
uiOutput("dates"),
sliderInput("bins",
"Binwidth:",
min = 1,
max = 5,
value = 2)
),
#main panel
mainPanel(
plotOutput("first_team_hist"),
plotOutput("second_team_hist")
)
)))
server.R
library(shiny)
library(dplyr)
library(ggplot2)
shinyServer(
function(input, output) {
mydf <- read.csv("batting_game_logs_merged.csv")
inputData_1 <- reactive({
filter(mydf,team == input$var_1 & season == input$season & date < as.Date(input$dates,format = "%Y-%m-%d"))
})
inputData_2 <- reactive({
filter(mydf,team == input$var_2 & season == input$season & date < as.Date(input$dates,format = "%Y-%m-%d"))
})
output$dates <- renderUI({
dates = mydf %>% filter(team == input$var_1 & opponent_team == input$var_2 & season == input$season) %>% select(date)
selectInput("dates","Pick a Game Date", as.character(dates[[1]]))
})
output$first_team_hist <- renderPlot({
myplot_1 <- ggplot(inputData_1(), aes(x = team_batting_gamelogs.R)) +
geom_histogram(aes(y = ..density..),
binwidth = input$bins, fill = I("blue"),col = I("red")) +
labs(title = paste("Runs Scored per game for",input$var_1),
x= "Runs Scored per Game", y = "Density")
print(myplot_1)
})
output$second_team_hist<- renderPlot({
myplot_2 <- ggplot(inputData_2(), aes(x = team_batting_gamelogs.R)) +
geom_histogram(aes(y = ..density..),
binwidth = input$bins, fill = I("blue"),col = I("red")) +
labs(title = paste("Runs Scored per game for",input$var_2),
x= "Runs Scored per Game", y = "Density")
print(myplot_2)
})
}
)
Thank you in advance for taking the time to review my problem.
-Josh
I am guessing your problem is the initial NULL value of your input$dates. Your reactive environments inputData_1/2 respond as soon as your UI is rendered (and they get their selected value). But no value has been assigned to input$dates yet, so your first run of these functions gets a NULL. Confirm that as.Date(NULL) yields exactly your error.
I advice you to make your reactive environments only listen to input$dates, i.e.
inputData_1 <- eventReactive(input$dates, {
filter(mydf,team == input$var_1 & season == input$season & date < as.Date(input$dates,format = "%Y-%m-%d"))
})
inputData_2 <- eventReactive(input$dates, {
filter(mydf,team == input$var_2 & season == input$season & date < as.Date(input$dates,format = "%Y-%m-%d"))
})
As far as I can see, you want computations to start only after inserting a date anyway.
Other possible fixes are to isolate the other variables or just add an if(!is.null(input$dates)){ ... } clause to handle NULL input.

Resources