闪亮 - 在模型之间切换

发布于 2025-02-03 03:53:25 字数 4723 浏览 2 评论 0原文

我已经构建了一个闪亮的应用程序来建模光滑的表面。薄板花键和张量产品平滑。不幸的是,当我尝试使用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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

椒妓 2025-02-10 03:53:25

如果这是唯一的问题,则将您的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())
  })

,最后将其用于预测AS

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

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)
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文