Home > Back-end >  Shiny - Switching Between Models
Shiny - Switching Between Models

Time:05-30

I've built a shiny app to model smooth surfaces. Thin plate splines and tensor product smooths. Unfortunately, when I try call input$Mod using functions such as get() it breaks. How can I call model fits? I don't want to remodel the same data on repeat each time the user makes an input selection.

The app reads a locally stored CSV

Shiny App

# Clear all
rm(list = ls(all.names = T))
gc()

iris <- get(data("iris"))
write.csv(iris, file = 'iris.csv', row.names = FALSE)


library(tidyverse)
library(mgcv)

# UI
ui <- navbarPage(title = "Analytics",
                 tabPanel("Models",
                          sidebarLayout(
                            sidebarPanel(width = 3,
                                         
                                         fileInput(inputId = "file1",
                                                   label = "Upload CSV",
                                                   accept = c(".csv")),
                                         
                                         uiOutput("RespSelector"),
                                         
                                         uiOutput("PredSelector"),
                                         
                                         selectInput(inputId = "Mod",
                                                     label = "Model Type:",
                                                     choices = c("Thin Plate Spline" = 'Model1',
                                                                 "Tensor Product Smooth" = 'Model2'))
                                         ),
                            
                            mainPanel(
                              verbatimTextOutput("Summary1"),
                              br(),
                              verbatimTextOutput("Summary2"))
                            
                            )))

# Server
server <- function(input, output, session) {
  
  # Upload CSV
  csv_data <- reactive({req(input$file1)
    
    # Read CSV and lightly trim tails
    read_csv(input$file1$datapath) %>%
      rowid_to_column("ID")
  })
  
  # Extract numeric colnames
  VARS_numeric <- reactive({req(input$file1, input$file1$datapath, csv_data())
    
    csv_data() %>%
      select(where(is.numeric), -ID) %>%
      colnames() %>%
      sort()
  })
  
  # Render response for UI selector
  output$RespSelector <- renderUI({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric())
    selectizeInput(inputId = "response",
                   label =  "Select 1 response variable",
                   selected = NULL,
                   choices = VARS_numeric(),
                   multiple = FALSE)
  })
  
  # Render predictor UI selector
  output$PredSelector <- renderUI({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric())
    selectizeInput(inputId = "predictors",
                   label =  "Select 2 predictors variables",
                   choices = VARS_numeric()[!(VARS_numeric() %in% input$response)],
                   multiple = TRUE,
                   options = list(maxItems = 2))
  })
  

  # Data
  Data <- reactive({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric(), input$predictors, input$predictors[1], input$predictors[2], input$response)
    csv_data()
  })

  # s(x1,x2) Equation
  ModelEquation1 <- reactive({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric(), input$predictors, input$predictors[1], input$predictors[2],
                                  input$response, Data())
    Equation1 <- as.formula(paste0(input$response," ~ ", 's(', input$predictors[1],',', input$predictors[2], ', bs = "tp")'))
  })
  
  # te(x1,x2) Equation
  ModelEquation2 <- reactive({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric(), input$predictors, input$predictors[1], input$predictors[2],
                                  input$response, Data())
    Equation2 <- as.formula(paste0(input$response,' ~ ', 'te(',input$predictors[1],',',input$predictors[2],')'))
  })
  
  
  # Model 1
  Model1 <- reactive({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric(), input$predictors, input$predictors[1], input$predictors[2],
                          input$response, Data(), ModelEquation1())
    gam(ModelEquation1(), method="REML", data = Data())
  })
  
  # Model 2
  Model2 <- reactive({req(input$file1, input$file1$datapath, csv_data(), VARS_numeric(), input$predictors, input$predictors[1], input$predictors[2],
                          input$response, Data(), ModelEquation2())
    gam(ModelEquation2(), method="REML", data = Data())
  })
  

  # Summary
  output$Summary1 <- renderPrint({req(Model1(), Model2())
    summary(get(Model1()))
  })
  
}

# Create Shiny app
shinyApp(ui = ui, server = server)

CodePudding user response:

If that is the only issue, you change your selectInput() as

selectInput(inputId = "Mod", label = "Model Type:", choices = c("Thin Plate Spline" = 'Model1',
                                                                 "Tensor Product Smooth" = 'Model2'))

Then create a eventReactive model as

  myModel <- eventReactive(input$Mod, {
    switch(input$Mod,
           "Model1" = Model1b(),
           "Model2" = Model2b())
  })

and lastly use this in predict as

Z <- matrix(predict(myModel(), newdat), steps, steps)
  • Related