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
Related
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)
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.
I would like to chose one of regression models from a selection of different kind of models and, then, apply it to a subset. But I've difficult to understand how I can paste the function in server.R
Here there is a part of code in ui.R
h3("Model Prediction"),
selectInput("regression", "Select Model:",
list("y~x",
"y~x^2")
In server.R I've written this code
dati<- as.data.frame( read.csv(file='file.csv', header=TRUE, sep=";", dec=","))
mydata <- reactive({
(pdata=subset(dati,index==input$proj))
})
shinyServer(function(input, output) {
#Simple plot
output$testPlot = renderPlot({
pdata=subset(dati,index==input$proj)
plot(pdata$gg, pdata$y )
})
###my data
mydata <- reactive({
(pdata=subset(dati,index==input$proj))
})
runRegression <- reactive({
lm(as.formula(paste(input$dependent," ~ ",paste(input$independent,collapse="+"))),data=dat)
})
})
You can try to use sprintf for it
like
selectInput("regression", "Select Model:",
list("y~x"="%s",
"y~x^2"="%s^2"))
as.formula(paste(input$dependent," ~ ",paste(sprintf(fmt = input$regression,input$independent),collapse="+")))
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())
})
})
)
This question already has answers here:
Error in <my code> : object of type 'closure' is not subsettable
(6 answers)
Closed 8 years ago.
I am using the following code and I always get the this subsettable error.
What am I subsetting and where am I wrong.
This should be some basic entry code that I modified and which did
work at some point and I can't see the error.
Thank you
server.R
library(shiny)
# Define a server for the Shiny app
shinyServer(function(input, output) {
# Filter data based on selections
output$table <- renderDataTable({
data <- read.table("my.csv", sep =',', header =TRUE)
if (input$shortdesc != "All"){
data <- data[data$ShortDescription == input$shortdesc,]
}
if (input$taken != "All"){
data <- data[data$Taken == input$taken,]
}
if (input$location != "All"){
data <- data[data$Location == input$location,]
}
data
})
})
ui.R
library(shiny)
# Define the overall UI
shinyUI(
fluidPage(
titlePanel("My Items"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("man",
"What:",
c("All",
unique(as.character(data$ShortDescription))))
),
column(4,
selectInput("trans",
"Where:",
c("All",
unique(as.character(data$Location))))
),
column(4,
selectInput("cyl",
"Who:",
c("All",
unique(as.character(data$Taken))))
)
),
# Create a new row for the table.
fluidRow(
dataTableOutput(outputId="table")
)
)
)
Update:
Why does the example (see below) work and the moment I change it to my.csv it breaks ?
If "data" is a buildin function wouldn't that collide also with the example below ?
Sorry for not understanding, but this puzzles me.
server.R
library(shiny)
# Load the ggplot2 package which provides
# the 'mpg' dataset.
library(ggplot2)
# Define a server for the Shiny app
shinyServer(function(input, output) {
# Filter data based on selections
output$table <- renderDataTable({
data <- mpg
if (input$man != "All"){
data <- data[data$manufacturer == input$man,]
}
if (input$cyl != "All"){
data <- data[data$cyl == input$cyl,]
}
if (input$trans != "All"){
data <- data[data$trans == input$trans,]
}
data
})
})
ui.R.
library(shiny)
# Load the ggplot2 package which provides
# the 'mpg' dataset.
library(ggplot2)
# Define the overall UI
shinyUI(
fluidPage(
titlePanel("Basic DataTable"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("man",
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
),
column(4,
selectInput("trans",
"Transmission:",
c("All",
unique(as.character(mpg$trans))))
),
column(4,
selectInput("cyl",
"Cylinders:",
c("All",
unique(as.character(mpg$cyl))))
)
),
# Create a new row for the table.
fluidRow(
dataTableOutput(outputId="table")
)
)
)
Expanding on #Roland 's comment: you have a namespace collision going on. There's a function data in base R, so if R can't find an object data in the current environment, the function data is referenced from the global environment. In your particular case, this happens because ui.R and server.R are in different environments, and, moreover, the individual function bodies all have their own environments. So the data in fluidRow(...) doesn't reference the datafrom output$table. You need to pass around arguments and/or dynamically construct the UI using the functions for that. See for example here.
Update for the updated question:
Replacing datawith mpg in ui.R fixes the problem because mpg is defined as a dataset in the global environment (this is a side effect of library(ggplot2)). So mpg is (almost) always accessible and has the necessary properties. For a fairer comparison, replace mpg in ui.R with data, which should bring back the old problem, because data in the global environment refers to a function and not the data frame you're trying to manipulate.
Super Update with more general solution for dynamically defining and loading selection elements for each dataset:
The server code loops through all the columns of the chosen dataframe and dynamically generates a selection box for every column that has a type other than double. (Uniqueness and equality with doubles is just asking for trouble.) This avoids the scoping issues because the UI elements are created in server.R after a call to the reactive function that loads the data.
server.R
library(shiny)
library(ggplot2)
# Define a server for the Shiny app
shinyServer(function(input, output) {
get.data <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars,
"mpg" = mpg,
"mtcars" = mtcars,
"diamonds" = diamonds)
})
# Filter my.data based on selections
output$table <- renderDataTable({
my.data <- get.data()
for(n in names(my.data)){
# avoid too many cases ...
# unique() with double is just asking for trouble
if(typeof(my.data[,n]) != "double"){
val <- eval(parse(text=paste0("input$",n)))
print(val)
if(val != "All"){
my.data <- eval(parse(text=paste0("subset(my.data,",n,"==",val,")")))
}
}
}
my.data
})
output$dyn.ui <- renderUI({
my.data <- get.data()
sel <- NULL
for(n in names(my.data)){
# avoid too many cases ...
# unique() with double is just asking for trouble
if(typeof(my.data[,n]) != "double"){
sel <- c(sel,
selectInput(n, n, choices=c("All",unique(my.data[,n])))
)
}
}
sel
})
})
ui.R
library(shiny)
# Define the overall UI
shinyUI(fluidPage(
titlePanel("Displaying tables dynamically with renderUI() and eval()"),
sidebarLayout(
sidebarPanel(h2("Selection"),
selectInput("dataset", "Dataset", c("rock", "pressure", "cars","mtcars","diamonds")),
# Create a new Row in the UI for selectInputs
uiOutput("dyn.ui")
)
,mainPanel(h2("Data"),
dataTableOutput(outputId="table")
)
)
))