Passing variable names to model in shiny app - r

I'm creating an app for simple linear regression using shiny. I want to pass variable names to the model automatically. I tried variable inputs from users. code in server.R is
lm(paste(input$dependent," ~ ",input$independent), data=data1())
and
lm(paste0(input$dependent) ~ paste0(input$independent), data=data1())
And also tried below syntax;
lm(names(data1()[2]) ~ names(data1()[1]) , data=data1())
these are all not working...
How can I pass variable names to the model?
Thanks in advance...

Your example isn't full enough for me to understand what errors you are running into, but I think this should do the trick:
lm(as.formula(paste(input$dependent," ~ ",paste(input$independent,collapse="+"))),data=dat)
A junky test shows that this is able to create dynamic models (although needs a bit of tweaking in other areas):
ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Test Shiny App"),
sidebarPanel(
selectInput("dependent", "Dependent Variable:", c("x","y","z")),
uiOutput("independent")
),
mainPanel(tableOutput("regTab"))
))
server.R
library(shiny)
dat <- data.frame(x=rnorm(100),y=rnorm(100),z=rnorm(100))
shinyServer(function(input, output, session) {
output$independent <- renderUI({
checkboxGroupInput("independent", "Independent Variables:",names(dat)[!names(dat) %in% input$dependent],names(dat)[!names(dat) %in% input$dependent])
})
runRegression <- reactive({
lm(as.formula(paste(input$dependent," ~ ",paste(input$independent,collapse="+"))),data=dat)
})
output$regTab <- renderTable({
if(!is.null(input$independent)){
summary(runRegression())$coefficients
} else {
print(data.frame(Warning="Please select Model Parameters."))
}
})
})

You basically need to pass a formula object to the lm call.
I find this easier than just using paste0. The question is more about formula than shiny, there are other ways to do this.
predictors = paste(input$independent,collapse="+")
fml = as.formula(sprintf('%s ~ %s', input$dependent, predictors))
fit = lm(fml, data=dat)

Related

RShiny regression with dynamic input

I am trying to build a linear regression that allows the user to select the dependent variable while independent variable are given with the lm() function. I currently get this errors message :
Can anyone help me, thank you for your time. Below is the code:
Warning: Error in [[: object of type 'closure' is not subsettable
(The part giving the error is the regression part), for the dataset there seems to be no problem, I can View the table used in the regression and it is fine. (input$property_name also work fine on it's own)
I deleted most of the code which I think was not relevant to make it easier to read
Ui
fluidPage(
fluidRow(
box(title="Filter Settings",status="primary",solidHeader=TRUE,collapsible=FALSE,width=2,style="height:120vh",
selectInput(inputId=ns("property_name"),label="Property to predict",choices=NULL,multiple=FALSE),
),
box(title="Predictive analysis",status="primary",solidHeader=TRUE,collapsible=FALSE,width=10,style="height:100vh",
withSpinner(
tabsetPanel(type = "tabs",
tabPanel("Teste",verbatimTextOutput(ns("Teste_output"))),
tabPanel("teste",verbatimTextOutput(ns("teste_output")))
)
)
)
)
)
Server
offlinePredictiveAnalysisServer <- function(input,output,session) {
values <- reactiveValues()
# Dynamically update the product code selection UI
observe({
product_selection <- unique(getSampleHeaderData()[,c("product_code","product_description")])
updateSelectInput(session,inputId="product_code",choices=sort(setNames(product_selection$product_code,product_selection$product_description)))
})
# Dynamically update the property selection UI
observe({
updateSelectInput(session,inputId="property_name",choices=sort(unique(getSamplePropertyData()$property_name)))
})
observeEvent(input$update,{
# Here I Get the batch offline property data in line with the selection parameters from de UI part( I deleted most of the parameters no relevant)
set.seed(123)
# 75% of the sample size
smp_size <- floor(0.70 * nrow(Ref_batch_offline_data))
# set the seed to make your partition reproducible
set.seed(123)
train_ind <- sample(seq_len(nrow(Ref_batch_offline_data)), size = smp_size)
train.data <- Ref_batch_offline_data[train_ind, ]
test.data <- Ref_batch_offline_data[-train_ind, ]
formula <- reactive({
paste0(input$property_name, "~", Glutamate) %>% as.formula()
})
# dummy model using reactive formula
model <- reactive({
lm(formula = formula(), data = train.data)
})
values[["df"]] <-model
)
# Make predictions on the test data
#predictions <- predict(model,newdata=Pred_batch_offline_data)
#View(predictions)
#values[["dff"]] <- predictions
})
output$Teste_output= renderPrint({
model<-values[["df"]]
summary(model)
})
output$teste_output= renderTable({
predictions <-values[["dff"]]
head(predictions)
})
}
Not 100% clear without having the data and all objects. Assuming Glutamate is a variable containing a string (so that this produces a valid formula) this could work with values[["df"]] <- model().
Since all the calculations already happen inside a reactive environment (observeEvent), this section
formula <- reactive({
paste0(input$property_name, "~", Glutamate) %>% as.formula()
})
# dummy model using reactive formula
model <- reactive({
lm(formula = formula(), data = train.data)
})
values[["df"]] <-model() #brackets added
can be simplified to
formula <- as.formula(paste0(input$property_name, "~", Glutamate))
model <- lm(formula, data = train.data)
values[["df"]] <- model
Here is a minimal demo for this on the iris dataset:
library(shiny)
ui <- fluidPage(
titlePanel("iris regression"),
sidebarLayout(
sidebarPanel(
selectInput("target", "regression target",
choices = c("Petal.Width", "Petal.Length"))
),
mainPanel(
plotOutput("summaryPlot")
)
)
)
server <- function(input, output) {
values <- reactiveValues()
observeEvent(input$target,{
formula <- as.formula(paste0(input$target, "~ ."))
model <- lm(formula, data = iris)
values[["model"]] <- model
})
output$summaryPlot <- renderPlot({
plot(values[["model"]])
})
}
shinyApp(ui = ui, server = server)

Create data partition function throwing this error - "y must have at least 2 data points"; while using it in reactive component in server.R shiny app

The app is asking the user to input predictor & dependent variables. For that I am using renderUI & uiOutput functions in server.R & ui.R files respectively. I am storing these inputs in predvar & depvar variables. Then i am using these variables in my reactive part of the code. This is where i think the problem of connection is between reactive code & user input variables. I have tried using caret::creatdatapartition instead of just createdatapartition.
server.R code
model <- reactive ({
prop = input$prop
predictor = input$predvar
dependent = input$depvar
if(length(predictor)==0){return("Select atleast one predictor")}
if(input$ex==TRUE){data <- datasets::iris}
else{file1 <- input$file
data = read.table(file = file1$datapath,sep =",",header = TRUE)
data = as.data.frame(data)}
set.seed(69)
inTrain <- createDataPartition(y=data$dependent,p=prop,list = FALSE) ## this line throws error
train <- data[inTrain,]
train <- train %>% select(predictor,dependent)
train(dependent~.,data=data,method = "rpart")
})
output$model <- renderPrint({
model()
)}
output$dependent <- renderUI({
if(input$ex==TRUE){
data = datasets::iris
dependents <- select_if(data,is.factor)
selectInput("depvar","Select the dependent variable",choices = colnames(dependents))
}
else{
file1 <- input$file
data = read.table(file = file1$datapath,sep =",",header = TRUE)
dependents <- select_if(data,is.factor)
selectInput("depvar","Select the dependent variable",choices = colnames(dependents))
}
})
output$predictor <- renderUI({
if(input$ex==TRUE){
data = datasets::iris
dependents <- select_if(data,is.numeric)
checkboxGroupInput("predvar","Select the predictor variables",choices = colnames(dependents))
}
else{
file1 <- input$file
data = read.table(file = file1$datapath,sep =",",header = TRUE)
dependents <- select_if(data,is.numeric)
checkboxGroupInput("predvar","Select the predictor variables",choices = colnames(dependents))
}
})
concerning ui.R code
checkboxInput("ex","Uncheck for using your own file",value = TRUE),
fileInput("file", "Upload the *.csv file with headers"),
uiOutput("dependent"),
uiOutput("predictor"),
sliderInput("prop",
"Enter the training data ratio",
min = .5,
max = 1,
value = .6,step = .05)
)
Shiny app output image link
You haven't given us a simple self contained example, so we can't give you a tested answer. But I think I can see at least two problems with your server code.
First, the model reactive looks like it will run then the server function is first called, before your predvar and depvar inputs have been populated. That's going to case a problem, but it's easy to fix: just put req(input$depvar, input$predvar at the start of the reactive. That will make sure the rest of the code in the reactive runs only once you've got values for both these inputs.
Second, the line you identified,
inTrain <- createDataPartition(y=data$dependent,p=prop,list = FALSE)
Says "create a data partition and assign the parameter y the contents of the column named 'dependent' in the data.frame data. What you want to say is "... using the contents of the column whose name is given by the value of my local variable dependent...".
So try
inTrain <- createDataPartition(y=data[[dependent]],p=prop,list = FALSE)
instead.
You may have other issues as well, but they're the two I spotted from what you've posted so far.
Based on our discussion below, here is a MWE:
library(shiny)
library(dplyr)
library(datasets)
ui <- shinyUI(
fluidPage(
titlePanel("Classification tree model on iris dataset."),
sidebarLayout(
sidebarPanel(
uiOutput("dependent"),
uiOutput("predictor"),
sliderInput("prop", "Enter the training data ratio", min = .5, max = 1, value = .6,step = .05) ),
mainPanel(
verbatimTextOutput("model")
)
)
)
)
server <- function(input, output) {
output$dependent <- renderUI({
data = datasets::iris
dependents <- select_if(data,is.factor)
selectInput("dependent","Select the dependent variable",choices = colnames(dependents))
})
output$predictor <- renderUI({
data = datasets::iris
predictors <- select_if(data,is.numeric)
checkboxGroupInput("predvar","Select the predictor variables", choices = colnames(predictors))
})
}
shinyApp(ui, server)
You had selectInput("depvar", ... rather than selectInput("dependent", ... in your output$dependent. That's all that was wrong.
A couple of points to note:
Your simple self-contained example (SSE)wasn't bad, but everything to do with model was irrelevant as far as I could see, so could be removed. There are also far easier ways of preenting the code to us than in multiple comments! ;)
In your SSE, I don't think there's a need for uiOutput and renderUI. You could present your checkBoxGroup and selectInput directly in the fluidPage and then use updateSelectInput() and updateCheckBoxGroupInput in an observe or observeEevent (the latter depending on data) reactive. That removes one level of indirection and might make things simpler whoever maintains your code. [NB: if you do this, you will need to change server <- function(input, output) {...} to server <- function(input, output, session) {...}.
Next time, rather than saying "I tried, and it didn't work" (I'm paraphrasing: I can't see your comments whilst writing an answer), say "I tried, but I got the following error [Give the error text] at line number nnn".
Good luck!

How to view the model result in shiny?

I want to develop generalised regression model which would allow user to select the variables of their choice and see the result. I do not seem to see the result.
library(shiny)
library(dplyr)
library(caret)
data(mtcars)
UI <- fluidPage(
titlePanel("MTCARS"),
selectInput("response","y",
names(mtcars)),
selectInput("Columns","Columns",
names(mtcars), multiple = TRUE),
actionButton('btn_train',label = 'Calibrate Model',
icon = icon('cogs'),#'bullseye','rocket'
class='btn-danger fa-lg',
width='100%'),
dataTableOutput("dfStr")
)
Server <- function(input, output) {
x <- reactive({as.character(input$Columns)})
y <- reactive({as.character(input$response)})
framework <- reactive({train(reformulate(x(), y()), data = mtcars, method='glm', maxit=500, trace=F)})
modeloutput <- reactive({
summary(framework())
})
observeEvent(input$btn_train,
output$dfStr <- renderPrint({
str(modeloutput())
}))
}
shinyApp(UI, Server)
It seems that the problem is that you are using dataTableOutput("dfStr") instead of verbatimTextOutput("dfStr").
Also the the Calibrate Model button is doing nothing since you are using reactive variables to build the model.

Plotting dynamic C5.0 decision tree in Shiny with reactiveValues()

I am developing a Shiny application to let users choose dependent / independent variables on demand then perform C5.0 to generate summary and a tree plot. However, there was error message when generating the plot regarding plot method could not find the appropriate object. This is an extended question of Plotting a dynamic C5.0 decision tree in Shiny. The plot method fails again after transforming iris to a reactiveValue() object rather than a simple dataframe, kindly find the code:
# ui.R
library(shiny)
fluidPage(
titlePanel('Plotting Decision Tree'),
sidebarLayout(
sidebarPanel(
h3('iris data'),
uiOutput('choose_y'),
uiOutput('choose_x'),
actionButton('c50', label = 'Generate C5.0 summary and plot')
),
mainPanel(
verbatimTextOutput('tree_summary'),
plotOutput('tree_plot_c50')
)
)
)
# server.R
library(shiny)
library(C50)
function(input, output) {
output$choose_y <- renderUI({
is_factor <- sapply(iris, FUN = is.factor)
y_choices <- names(iris)[is_factor]
selectInput('choose_y', label = 'Choose Target Variable', choices = y_choices)
})
output$choose_x <- renderUI({
x_choices <- names(iris)[!names(iris) %in% input$choose_y]
checkboxGroupInput('choose_x', label = 'Choose Predictors', choices = x_choices)
})
# tranforming iris to reactiveValues() object
react_vals <- reactiveValues(data = NULL)
react_vals$data <- iris
observeEvent(input$c50, {
form <- paste(isolate(input$choose_y), '~', paste(isolate(input$choose_x), collapse = '+'))
c50_fit <- eval(parse(text = sprintf("C5.0(%s, data = %s)", form, 'react_vals$data')))
output$tree_summary <- renderPrint(summary(c50_fit))
output$tree_plot_c50 <- renderPlot({
plot(c50_fit)
})
})
}
My guess is that the plot method is looking for react_vals in the global environment; if that's the case, an easy solution (but not ideal) would be to assign iris to a variable in the global environment, using <<-. In your server.R:
# tranforming iris to reactiveValues() object
react_vals <<- reactiveValues(data = NULL)
react_vals$data <<- iris
A simple experiment confirms my guess; wrapping C5.0() and then plot() in a function throws an error:
library(C50)
test <- function(dat) {
fit <- C5.0(Species ~ Sepal.Length, dat)
plot(fit)
}
test(iris)
# Error in is.data.frame(data) : object 'dat' not found

Possible to pass a model to output in a shiny app?

I would like to select a feature and model (from sidebar dropdown menu's) and be able to pass the model to a specific output where I print the summary of the model and show how well the model fits graphically. I currently have a reactive function in server.R that checks which input$model is selected, then fits the model and returns it. When I try to call this reactive function from output$evaluation I get errors. I'm not sure how to do this.
# server.R
#...
fitter <- reactive({
df_clean <- dataset() # another reactive function that selects the dataset to be used
rownames(df_clean) <- df_clean$timestamp
df_clean$timestamp <- NULL
if (input$Model == 'Linear'){
fit <- lm(input$Response ~., data=df_clean)
}
#... more if statements checking for other model types
return(fit)
})
# Model Evaluation
output$Evaluation <- renderPrint({
summary(fitter())
})
You can convert the string in your lm call to a formula, using as.formula.
library(shiny)
shinyApp(
shinyUI(
fluidPage(
inputPanel(
selectInput("Model", "Model:", choices=c("Linear", "Other")),
selectInput("Response", "Response:", choices=c("mpg", "disp"))
),
tableOutput("Evaluation")
)
),
shinyServer(function(input, output, session) {
fitter <- reactive({
df_clean <- mtcars
if (input$Model == 'Linear'){
fit <- lm(as.formula(paste(input$Response, "~.")), data=df_clean)
}
return(fit)
})
output$Evaluation <- renderTable({
summary(fitter())
})
})
)

Resources