I have a R Shiny app, which calculates several statistics in different tabsets. As the calculations are quite computation intensive, I use submitButton to prevent reactivity. My problem is now that each calculation (all in different tabsets) are writing outputs to a folder and I want Shiny to write an output for all tabsets when initializing. Unfortunately, Shiny only creates an output for the tabset, that is active when initializing. Is there a way to tell Shiny, that it should calculate/render outputs for every tab when initializing?
Here is a modified example from the Shiny[Tutorial]:(http://www.http://rstudio.github.io/shiny/tutorial/#more-widgets/)
ui.R:
library(shiny)
# Define UI for dataset viewer application
shinyUI(pageWithSidebar(
# Application title.
headerPanel("More Widgets"),
# Sidebar with controls to select a dataset and specify the number
# of observations to view. The helpText function is also used to
# include clarifying text. Most notably, the inclusion of a
# submitButton defers the rendering of output until the user
# explicitly clicks the button (rather than doing it immediately
# when inputs change). This is useful if the computations required
# to render output are inordinately time-consuming.
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
numericInput("obs", "Number of observations to view:", 10),
helpText("Note: while the data view will show only the specified",
"number of observations, the summary will still be based",
"on the full dataset."),
submitButton("Update View")
),
# Show a summary of the dataset and an HTML table with the requested
# number of observations. Note the use of the h4 function to provide
# an additional header above each output section.
mainPanel(
tabsetPanel(
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("view"))
)
)
))
server.R:
library(shiny)
library(datasets)
# Define server logic required to summarize and view the selected dataset
shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
# Generate a summary of the dataset
output$summary <- renderPrint({
dataset <- datasetInput()
capture.output(summary(dataset),file="summary.txt")
})
# Show the first "n" observations
output$view <- renderTable({
a<-head(datasetInput(), n = input$obs)
capture.output(a,file="table.txt")
})
})
I think you want:
outputOptions(output, "summary", suspendWhenHidden = FALSE)
outputOptions(output, "view", suspendWhenHidden = FALSE)
Put this into your server.R. Let me (us) know if this works as you expect.
Documentation:
http://www.inside-r.org/packages/cran/shiny/docs/outputOptions
Related
I have been working on a shiny app which uses auto.arima() from the package, along with an xreg parameter. For some reason, the xreg function (which takes a data frame or matrix) has stopped accepting the output of a reactive function - which is a subsetted dataframe. The work-around sucks, and so I'm hoping someone knows a good way to fix this.
Shiny produces this ERROR:
xreg should be a numeric matrix or vector
I've tried:
re-installing: forecast, shiny, dplyr, and completing wiping our R and Rstudio, and re-installing from scratch.
I've tried rolling back the forecast package to the build from 6 months ago (when this was working)
I've tried rolling back R to the build from 6 months ago (when this was working)
I've tried using other forecast packages; bsts for example seems to work just fine
This is some minimally viable shiny code. Create a .csv with 3 columns of data, be sure to name the columns, like y, x1 and x2.
library(shiny)
library(forecast)
library(dplyr)
ui <- fluidPage(
# Application title
titlePanel("arima test"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
# Input: Select a file ----
fileInput("uploaded_file", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
uiOutput("dv_dropdown"),
uiOutput("iv_checkbox")
),
# Show a plot of the generated distribution
mainPanel(
verbatimTextOutput("model"),
tableOutput('data')
)
)
)
server <- function(input, output) {
# Read .csv file ----
df <- reactive({
req(input$uploaded_file)
read.csv(input$uploaded_file$datapath,
header = TRUE)
})
# Dynamically generate a list of the dependent variables for the user to choose from the uploaded .csv ----
output$dv_dropdown <- renderUI({
selectInput(inputId = "select_dependents",
label = "dependent time series:",
choices = names(df()[,c(-1)])
)
})
# Dynamically generate a list of the independent variables for the user to choose ----
output$iv_checkbox <- renderUI({
checkboxGroupInput(inputId = "select_ivs",
label = "Select Independent variables:",
choices = setdiff(names(df()[,c(-1)]), input$select_dependents),
selected = setdiff(names(df()), input$select_dependents))
})
####### CREATE REACTIVE DATA OBJECTS BASED ON FILTERS #################
# this creates a dataframe of the dependent time series
df_sel <- reactive({
req(input$select_dependents)
df_sel <- df() %>% select(input$select_dependents)
})
# this creates a dataframe of the dependent time series
df_indep <- reactive({
req(input$select_ivs)
df_indep <- df() %>% select(input$select_ivs)
})
#proof that the independent variables are in fact in a matrix/dataframe
output$data <- renderTable({
df_indep()
})
#This is the TEST ARIMA Model
modela <- reactive({
modela <- auto.arima(df_sel(), xreg = df_indep()) #model with regressors
#modela <- auto.arima(df_sel()) #model without regressors to demonstrate that it actually works without the xreg argument
})
#this is the solution to the xreg problem above, but there's no reason I can think of that xreg shouldn't be able to take a reactive data object like it was doing before...
#x = as.matrix(as.data.frame(lapply(df_indep(), as.numeric)))
# then set: xreg = x
output$model <- renderPrint({
summary(modela())
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to plot a stock chart using quantmod in a shiny app but I get the following error: input$stockInput download failed after two attempts. Error message: HTTP error 404. Any help is appreciated.
Server:
library(quantmod)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
price <- getSymbols('input$stockInput',from='2017-01-01')
plot(price)
})})
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("Stock Chart"),
sidebarLayout(
sidebarPanel(
#This is a dropdown to select the stock
selectInput("stockInput",
"Pick your stock:",
c("AMZN","FB","GOOG","NVDA","AAPL"),
"AMZN"),selected = "GOOG"),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
))))
Thank you.
Your code requires a few changes. First when you are accessing a shiny UI object in server.R you should use it as an object not as a quoted character
price <- getSymbols(input$stockInput,from='2017-01-01')
And the function getSymbols without a value set to the argument (auto.assign = F) creates a new xts object in the stock name whose data is requested and so in the below code I've used it with setting auto.assign = F so it becomes easier to access the object price for plotting. Otherwise, you might have to fetch the value inside price using get() and then plot them as I've commented.
server.R
library(quantmod)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
price <- getSymbols(input$stockInput,from='2017-01-01', auto.assign = F)
#plot(get(price), main = price) #this is used when auto.assign is not set by default which is TRUE
plot(price, main = input$stockInput) # this is when the xts object is stored in the name price itself
})})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Stock Chart"),
sidebarLayout(
sidebarPanel(
#This is a dropdown to select the stock
selectInput("stockInput",
"Pick your stock:",
c("AMZN","FB","GOOG","NVDA","AAPL"),
"AMZN"),selected = "GOOG"),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
))))
Hope it clarifies!
I have a question that falls more into a "best practice" type of inquiry. When using shiny package in r, is it better to create all widgets on the server side using renderUI and then pushing those to the ui via uiOutput? Or, when possible, should all widgets be created on the ui side?
For instance, the two apps below do the same thing but in the second one, I create the sliderInput on the server side and then push that to the ui rather than creating it in the ui side. (Note, this code is pulled from the Hello Shiny page on R Studio)
App 1 - "Standard Approach" creating widget in ui
#ui.R
# Define UI for application that plots random distributions
library(shiny)
ui1 <- shinyUI(fluidPage(
# Application title
titlePanel("Hello Shiny!"),
# Sidebar with a slider input for number of observations
sidebarLayout(
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 1,
max = 1000,
value = 500)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
))
#server.R
# Define server logic required to generate and plot a random distribution
library(shiny)
server1 <- (function(input, output) {
output$distPlot <- renderPlot({
# generate an rnorm distribution and plot it
dist <- rnorm(input$obs)
hist(dist)
})
})
runApp(shinyApp(ui = ui1, server = server1))
App 2 - Alternative Approach - Creating Widget on server side
#ui.R
# Define UI for application that plots random distributions
library(shiny)
ui2 <- shinyUI(fluidPage(
# Application title
titlePanel("Hello Shiny!"),
# slider comes from the si object created in server.R
sidebarLayout(
sidebarPanel(
uiOutput("si")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
))
#server.R
# Define server logic required to generate and plot a random distribution
library(shiny)
server2 <- (function(input, output) {
#create slider with renderUI
output$si <- renderUI(
sliderInput("obs",
"Number of observations:",
min = 1,
max = 1000,
value = 500)
)
output$distPlot <- renderPlot({
# generate an rnorm distribution and plot it
dist <- rnorm(input$obs)
hist(dist)
})
})
runApp(shinyApp(ui = ui2, server = server2))
To me, the second approach is more generalizable so it should win. However, I am no expert and I rarely see this approach being used unless there is a specific reason why you need the widgets to be responsive in some way. The ways in which I have required responsiveness include:
There is data loaded on the server side which ends up feeding the widget choices so it is better to only load the data one time on the server side and create the widgets there, rather than load it on the server and ui side.
We need to turn off/on widgets and/or allow them to react to other user input
Since the second approach I've presented can handle the above two options, it makes sense to me that it should be used in all cases, even when there is no real need to create the widget on the server side. I notice that when using the second approach, there is a delay, sometimes accompanied by warnings/errors prior to the widgets being loaded. That is the only downside I've noticed about the approach.
Is one of these approaches considered a "best practice?"
Thanks.
Note: Please feel free to criticize the code I have written as I'm learning, what I did wrong, how I can improve etc.
I am learning R and shiny and would like to implement a calculation using the users input, however I am having difficulty storing the user input into a data frame for me to access to run a calculation later.
My idea is to get the user to define a probability distribution for his or her selected variables from the iris dataset. Once he defines them I want to store those defined variables into a data frame so that I can run a calculation such as a Monte Carlo etc. using the users defined data frame later on (so I would need to call upon that as a data frame).
I have tried to make the code as simple as possible below :
library(shiny)
ui <- fluidPage(
fluidRow(
column(4,
wellPanel(
selectizeInput(inputId= "invar", label= "Select Variable",
choices= names(iris),
selected= names(iris)[1],
multiple=T),
uiOutput("moC"))),
mainPanel(
tableOutput("tab")
)
))
server <- function(input, output) {
sorted <- reactive({
data <- iris[ ,c(input$invar)]
data})
output$moC <- renderUI({
numvar<- length(input$invar)
lapply(1:numvar, function(i) {
tagList(
selectInput("inv",paste0("Please Select Probability Distribution of ", input$invar[i]),
choices = c("Normal","Uniform")),
conditionalPanel(condition = "input.inv=='Normal'",
textInput("invarpdfmean","Please Select Input Variable Mean:",0.25),
textInput("invarpdfsd","Please Select Input Variable Standard Deviation", 0.02)),
conditionalPanel(condition = "input.inv=='Uniform'",
textInput("invarpdfmin","Please Select Minimum Input Variable Value:",0.18),
textInput("invarpdfmax","Please Select Maximum Input Variable Value", 0.3))
)})})
}
EDIT: Updated code as per comments. Thanks
library(shiny)
ui <- fluidPage(
fluidRow(
column(4,
wellPanel(
selectizeInput(inputId= "invar", label= "Select Variable",
choices= names(iris),
selected= names(iris)[1],
multiple=TRUE),
uiOutput("moC"))),
mainPanel(
tableOutput("tab")
)
))
server <- function(input, output) {
sorted <- reactive({
iris[input$invar]
})
output$moC <- renderUI({
numvar<- length(input$invar)
lapply(1:numvar, function(i) {
tagList(
selectInput("inv",paste0("Please Select Probability Distribution of ", input$invar[i]),
choices = c("Normal","Uniform")),
conditionalPanel(condition = "input.inv=='Normal'",
textInput("invarpdfmean","Please Select Input Variable Mean:",0.25),
textInput("invarpdfsd","Please Select Input Variable Standard Deviation", 0.02)),
conditionalPanel(condition = "input.inv=='Uniform'",
textInput("invarpdfmin","Please Select Minimum Input Variable Value:",0.18),
textInput("invarpdfmax","Please Select Maximum Input Variable Value", 0.3))
)})})
}
shinyApp(ui, server)
EDIT 2:
Seems I wasn't clear apologize:
The desired output is a histogram of a linear model of the users selected variables with the data coming from the users defined variables. So if he selects Sepal.Length and Petal.Length and defines them with a uniform or normal distribution I want to run a Monte Carlo on the linear model using a data frame created from the users input.
So later on i want to run a code that looks something like this:
n<-1000
Lm <- Sepal.Length + Petal.Length
for (n in 1:n) {
H=predict(LM,MCtab)
}
where MCtab would be a data frame which is created by the user using the variables he or she selects. This is what I have not been able to figure out how to do.
For MCtab (which is just a subset of your dataset based on user selected inputs), you can use MCtab <- iris[ , input$invar]. Note the comma there. Also, you should check if input$invar is empty in case user has deleted all the choices.
In a Shiny app, is there a way to keep old reactive output and display it in the app along with new reactive output? To provide an example: say I want to display the summary table of a linear model to which I gradually add more variables. I currently have a checkboxGroupInput panel using which I select the explanatory variables to be included in the model, and then I render a table which contains the summary of the model estimated using the selected variables. Now when I decide to use a different set of variables, I'd like to keep the original summary table displayed but also add the new summary table below the old one. If possible, I'd like to display all past instances of the reactive table, i.e., the number of tables displayed in the app should be equal to the number of different sets of explanatory variables I have decided to use throughout the app. At the moment, the table is rendered with htmlOutput in the ui part and stargazer package and renderText in the server part.
Here's an approach that works. It uses a reactiveValues object, and each time you click the "Fit Model" button, it appends the new model to the end of the list. The numeric input controls how many models to display on the screen. This preserves every model you fit in the session.
I didn't do the stargazer table because I'm not that familiar with it. But you should be able to adapt this pretty easily.
library(shiny)
library(broom)
shinyApp(
ui =
shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput(inputId = "indep",
label = "Independent Variables",
choices = names(mtcars)[-1],
selected = NULL),
actionButton(inputId = "fit_model",
label = "Fit Model"),
numericInput(inputId = "model_to_show",
label = "Show N most recent models",
value = 2)
),
mainPanel(
htmlOutput("model_record")
)
)
)
),
server =
shinyServer(function(input, output, session){
Model <- reactiveValues(
Record = list()
)
observeEvent(
input[["fit_model"]],
{
fit <-
lm(mpg ~ .,
data = mtcars[c("mpg", input[["indep"]])])
Model$Record <- c(Model$Record, list(fit))
}
)
output$model_record <-
renderText({
tail(Model$Record, input[["model_to_show"]]) %>%
lapply(tidy) %>%
lapply(knitr::kable,
format = "html") %>%
lapply(as.character) %>%
unlist() %>%
paste0(collapse = "<br/><br/>")
})
})
)