'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)
    
  })
  
}


Solution 1:[1]

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)

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 pholzm