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/>")
})
})
)
Related
I am currently doins a personal project to get used to using R-shiny. I am using the penguins dataset in R. This project is creating several different boxplots. I have been able to create the main code for the boxplots to show and now I am trying to use the checkbox input to allow the user to select if it wants the boxplots to be divided by the Islands ivestigated or rather just see the data as it.
My code is the following.
library("palmerpenguins")
library("shiny")
library("ggplot2")
penguins.data<- penguins
sum(is.na(penguins))
#As their are a few penguins with missing values (19 out of 2752) we decide to carry out the data visualization with
#Only the complete cases of the data
penguins.data<-na.omit(penguins.data)
#Making sure the categorical variables are factors
str(penguins.data)
penguins.data$species<-as.factor(penguins.data$species)
penguins.data$sex<-as.factor(penguins.data$sex)
penguins.data$year<-as.factor(penguins.data$year)
penguins.data$island<-as.factor(penguins.data$island)
#Defining the UI for the App.
ui <- fluidPage(
#Adding a suitable title
titlePanel("Penguin exploration"),
#Getting the layout
sidebarLayout(
#Setting the panel for the used to select the inputs they want
sidebarPanel(
#Selecting the variable for the X-axis
selectInput("horiz", "Select x-axis variable:",
c("Sex" = "sex",
"Species" = "species",
"Year" = "year"),
selected = "sex" ),
#Selecting the variable in the Y-axis
selectInput("vert", "Select y-axis variable:",
c("Bill Length" = "bill_length_mm",
"Bill Depth" = "bill_depth_mm",
"Flipper length" = "flipper_length_mm",
"Body mass" = "body_mass_g"),
selected = "flipper_length_mm" ),
#We create the checkbox input for the user to select if they want to see the data in
checkboxInput("Divide", "check to look at how data is divided by Island Level", value = F)),
mainPanel(
#Setting a title for the output
h3("plot"),
#We decide how to name the plot to use it in the output
plotOutput("PengPlot")
),
)
)
server <- function(input, output) {
horizontal<-reactive(input$horiz)
vertical<-reactive(input$vert)
output$PengPlot <- renderPlot({
if(output$Divide){
ggplot(data = penguins.data, aes_string(horizontal(), vertical()))+
geom_boxplot(aes(fill= island))+
facet_wrap(~horizontal())
}else{
ggplot(data = penguins.data, aes_string(horizontal(), vertical()))+
geom_boxplot()
}
})
}
shinyApp(ui = ui, server = server)
I am currently getting the error Reading from shinyoutput object is not allowed. I am lost on what specifically to do. I am considering if maybe creating both boxplots as reactive objects and then use the if functions but I have seen in other posts that doing that may overcomplicate the code.
Any advice or help will be great. Thank in advance
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'm trying to make a simple shiny ap for creating kaplan-meier survival curves that are stratified by selection the user makes. When I code the KM calculation statically (with the column name thorTr) it works but the calculation and plot is static. When I replace with input$s I get ERROR:variable lengths differ (found for 'input$s')
I've tried looking at other code which use as.formula and paste, but I don't understand and couldn't get to work. But I am a new R and Shiny user so maybe I didn't get it right. Here is a similar shiny ap but I want to use survminer and the ggsurvplot for plotting
library(shiny)
library(ggplot2)
library(survival)
library(survminer)
#load data
data(GBSG2, package = "TH.data")
#Define UI for application that plots stratified km curves
ui <- fluidPage(
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable strat
selectInput(inputId = "s",
label = "Select Stratification Variable:",
choices = c("horTh","menostat","tgrade"),
selected = "horTh")
),
# Outputs
mainPanel(
plotOutput(outputId = "km")
)
)
)
# Define server function required to create the km plot
server <- function(input, output) {
# Create the km plot object the plotOutput function is expecting
output$km <- renderPlot({
#calc KM estimate with a hard coded variables - the following line works but obviously is not reactive
#km <- survfit(Surv(time,cens) ~ horTh,data=GBSG2)
#replaced hard coded horTh selection with the respnse from the selection and I get an error
km <- survfit(Surv(time,cens) ~ input$s ,data=GBSG2)
#plot km
ggsurvplot(km)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
I expect to have a plot that updates the stratification variable with the users selection
Try using surv_fit() instead of survfit().
surv_fit() is a helper from survminer which does different scoping compared to survival:survit(), which is what you seem to need, as Byron suggests.
My snippet looks like:
output$plot <- renderPlot({
formula_text <- paste0("Surv(OS, OS_CENSOR) ~ ", input$covariate)
## for ggsurvplot, use survminer::surv_fit instead of survival:survfit
fit <- surv_fit(as.formula(formula_text), data=os_df)
ggsurvplot(fit = fit, data=os_df)
})
Two things:
The formula in the call to survfit() needs to be defined explicitly. The object being passed to survfit() in the original code uses a character value on the right hand side of the function. This throws an error, which we can address by translating the entire pasted value into a formula, i.e., as.formula(paste('Surv(time,cens) ~',input$s))
The formula needs to be defined in the call to ggsurvplot() to avoid scoping issues. This is a little more technical and has to do with the way that ggsurvplot() is programmed. Basically, ggsurvplot() can't access a formula that is defined outside of its own call.
Try replacing
km <- survfit(Surv(time,cens) ~ input$s ,data=GBSG2)
ggsurvplot(km)
with
ggsurvplot(survfit(as.formula(paste('Surv(time,cens) ~',input$s)),data=GBSG2))
Hi finally got this to work combinigng both solutions. I don't understand the fix but at least it now works the way I wanted it to :)
library(shiny)
library(ggplot2)
library(survival)
library(survminer)
data(GBSG2, package = "TH.data")
# Define UI for application that plots features of movies
ui <- fluidPage(
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable strat
selectInput(inputId = "s",
label = "Select Stratification Variable:",
choices = c("Hormone Therapy" = "horTh",
"Menopausal Status" = "menostat",
"Tumor Grade" = "tgrade"),
selected = "horTh")
),
# Outputs
mainPanel(
plotOutput(outputId = "km")
)
)
)
# Define server function required to create the scatterplot
server <- function(input, output) {
# Create the km plot object the plotOutput function is expecting
output$km <- renderPlot({
## calc survival curve and plot
kmdata <- surv_fit(as.formula(paste('Surv(time,cens) ~',input$s)),data=GBSG2)
ggsurvplot(kmdata)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
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.
I'd be happy to get some help with R shiny, I'm new to it.
I built a logistic regression model that runs on a training set called "Rdata1.csv".
Then after I train the model I want let the user upload a test set file
and run the predictions on the test set.
Here is my ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Predictions"),
sidebarLayout(
sidebarPanel(
fileInput("file", label = h3("Upload CSV")),
hr(),
fluidRow(column(4, verbatimTextOutput("value")))
),
mainPanel(
textOutput("text1")
)
)
))
Here is my server.R:
library(shiny)
library(aod)
library(ROCR)
mydata <- read.csv("C:/Rdata1.csv")
mydata$Continent <- factor(mydata$Continent)
mydata$IP <- factor(mydata$IP)
mylogit <- glm(Good ~ Continent + IP, data = mydata, family = "binomial")
shinyServer(function(input, output) {
output$text1 <- renderPrint({
mydatanew <- read.csv(input$file[4])
mydatanew$Continent <- factor(mydatanew$Continent)
mydatanew$IP <- factor(mydatanew$IP)
mydatanew$predicted<-predict(mylogit, newdata=mydatanew, type="response")
paste("predictions", mydatanew)
})
}
)
In the app I get no output - instead it I get the error:
"file must be a character string or connection" and i see nothing.
Anyone know what's wrong with the code?
Thanks!
Welcome to SO. This question is hard to make reproducible, but it looks like the datapath from fileInput is not being passed correctly. See ?fileInput:
Whenever a file upload completes, the corresponding input variable is set to a dataframe.
This dataframe contains one row for each selected file, and the following columns: ...
... the fourth of which is datapath.
In other words
file <- data.frame(name="foo",size=999,type="text/plain",datapath = "~/temp/whatever.csv", stringsAsFactors=FALSE)
str(file[4]) # this gives you a little data frame, probably not what you want
str(file[1,4]) # this gives you the character value itself
Does that work?