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)