闪亮 - 在模型之间切换
我已经构建了一个闪亮的应用程序来建模光滑的表面。薄板花键和张量产品平滑。不幸的是,当我尝试使用get()
之类的函数的功能,尝试调用输入$ 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)
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)
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
如果这是唯一的问题,则将您的
selectInput()
更改为,然后创建一个EventReactive模型
,最后将其用于预测AS
If that is the only issue, you change your
selectInput()
asThen create a eventReactive model as
and lastly use this in predict as