闪亮 - 在模型之间切换
Shiny - Switching Between Models
我构建了一个闪亮的应用程序来模拟光滑的表面。薄板样条和张量积平滑。不幸的是,当我尝试使用 get()
等函数调用 input$Mod
时,它中断了。
如何调用模型拟合?我不想在每次用户进行输入选择时重复重塑相同的数据。
应用程序读取本地存储的 CSV
闪亮的应用程序
# 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)
如果这是唯一的问题,您将 selectInput()
更改为
selectInput(inputId = "Mod", label = "Model Type:", choices = c("Thin Plate Spline" = 'Model1',
"Tensor Product Smooth" = 'Model2'))
然后创建一个 eventReactive 模型作为
myModel <- eventReactive(input$Mod, {
switch(input$Mod,
"Model1" = Model1b(),
"Model2" = Model2b())
})
最后在预测中使用它作为
Z <- matrix(predict(myModel(), newdat), steps, steps)
我构建了一个闪亮的应用程序来模拟光滑的表面。薄板样条和张量积平滑。不幸的是,当我尝试使用 get()
等函数调用 input$Mod
时,它中断了。
如何调用模型拟合?我不想在每次用户进行输入选择时重复重塑相同的数据。
应用程序读取本地存储的 CSV
闪亮的应用程序
# 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)
如果这是唯一的问题,您将 selectInput()
更改为
selectInput(inputId = "Mod", label = "Model Type:", choices = c("Thin Plate Spline" = 'Model1',
"Tensor Product Smooth" = 'Model2'))
然后创建一个 eventReactive 模型作为
myModel <- eventReactive(input$Mod, {
switch(input$Mod,
"Model1" = Model1b(),
"Model2" = Model2b())
})
最后在预测中使用它作为
Z <- matrix(predict(myModel(), newdat), steps, steps)