在 Shiny 中使用 selectInput 绘制不同的回归线

编程问答 2022-05-14

问题描述

我正在练习使用 alr4 包中的 baeskel 数据创建一些闪亮的应用程序。我的目标是创建一个 selectInput 下拉菜单，以便用户可以选择要绘制的回归线。我不确定如何安排服务器部分的代码。到目前为止，对于一条绘制的线，我已经创建了这个：

library(alr4)
data("baeskel")
ui <- fluidPage(
  sidebarLayout(position="left",sidebarPanel("sidebarPanel",width=4),mainPanel(
                  tabsetPanel(type = "tabs",tabPanel("baeskal Data",tableOutput("table")),tabPanel("polynomial Regression",plotOutput("polyplot"))
                              )
                          )
                )
  )
  
server <- function(input,output){
  output$table <- renderTable({
    baeskel
  })
  
  x <- baeskel$Sulfur
  y <- baeskel$Tension
  output$polyplot <- renderPlot({
    plot(y~x,pch = 16,xlab="Sulfur",ylab="Tension",main = "Observed Surface Tension of\nLiquid copper with varying Sulfur Amount")
    linear_mod = lm(y~x,data = baeskel)
    linear_pred = predict(linear_mod)
    lines(baeskel$Sulfur,linear_pred,lwd=2,col="blue")
    })
  
}

shinyApp(ui = ui,server = server)

效果非常好。我的下一个目标是添加另一条回归线，如下所示：

quadratic_mod <- lm(Tension ~ poly(Sulfur,2),data = baeskel)
quadratic_pred <- predict(quadratic_mod)
lines(baeskel$Sulfur,quadratic_pred,lwd = 2,col = "green")

但是我想使用 selectInput 函数如下（尚未在侧边栏布局中显示）：

selectInput(inputId =,"Choose Regression Line:",c("Linear","Quadratic"))

我不知道如何选择 inputId 以便它可以从每个回归线中收集信息。

解决方法

这是一个工作示例，允许以闪亮的方式绘制不同的预测模型。

在您的 ui 中，添加 selectInput 以选择回归线的类型。

在 server 中，您可以添加 if 语句来检查此输入，并根据数据确定要构建的模型。

将相应地从模型和线条中得出适当的预测。

library(alr4)
library(shiny)

data("baeskel")

ui <- fluidPage(
  sidebarLayout(position="left",sidebarPanel(
                  "sidebarPanel",width=4,selectInput(inputId = "reg_line","Choose Regression Line:",c("Linear","Quadratic"))),mainPanel(
                  tabsetPanel(type = "tabs",tabPanel("baeskal Data",tableOutput("table")),tabPanel("Polynomial Regression",plotOutput("polyplot"))
                  )
                )
  )
)

server <- function(input,output){
  output$table <- renderTable({
    baeskel
  })
  
  output$polyplot <- renderPlot({
    plot(Tension ~ Sulfur,data = baeskel,pch = 16,xlab="Sulfur",ylab="Tension",main = "Observed Surface Tension of\nLiquid Copper with Varying Sulfur Amount")
    
    if(input$reg_line == "Linear") {
      baeskel_mod = lm(Tension ~ Sulfur,data = baeskel)
    } else {
      baeskel_mod = lm(Tension ~ poly(Sulfur,2),data = baeskel)
    }
    
    baeskel_pred = predict(baeskel_mod)
    lines(baeskel$Sulfur,baeskel_pred,lwd=2,col="blue")
  })
  
}

shinyApp(ui = ui,server = server)
rrselectinputshiny