R中的闪亮包

Question

我正在 R 中练习闪亮的包。我正在创建一个应用程序，用户在其中选择两个变量并确定要适合相应散点图的曲线的程度。为此，我正在使用 mtcars 数据。我使用 selectinput 命令来获取变量。我希望滑块输入命令来决定拟合曲线的程度。除了滑块输入命令之外，代码似乎都在工作。

library(shiny)

ui <- fluidPage(
  headerPanel('Fitting a curve'),
  sidebarPanel(
    selectInput(inputId = "xcol",label = "X-Axis",choices = names(mtcars)),
    selectInput(inputId = "ycol",label = "Y-Axis",choices = names(mtcars),selected = names(mtcars)[[3]]),
    sliderInput(inputId = "degree",label = "Degree of fit",min = 0,max = 2,value = 0)
  ),
  mainPanel(plotOutput("plot1"))

)

server <- function(input,output){
  x <- reactive({mtcars[,input$xcol]})
  y <- reactive({mtcars[,input$ycol]})
  z <- renderPrint({ifelse(input$degree==0,lm(y()~),ifelse(input$degree==1,lm(y()~x()),lm(y()~x()+x()^2)))})
  output$plot1 <- renderPlot({
    plot(x(),y(),col = "red")
    abline(z())
    })

}

shinyApp(ui = ui,server = server)

很确定服务器部分的“z”行有错误。请帮助我是闪亮包的新手。

Answer 1

1. 不要在这里使用ifelse，if (...) {...} else {...} 更好（而且它不会破坏东西）。为什么？比较这两个：

   mdl1 <- ifelse(1 == 1, lm(mpg~disp, data=mtcars), lm(mpg~disp+cyl, data=mtcars))
   class(mdl1)
   # [1] "list"
   mdl1
   # [[1]]
   # (Intercept)        disp 
   # 29.59985476 -0.04121512 
   
   mdl2 <- if (1 == 1) lm(mpg~disp, data=mtcars) else lm(mpg~disp+cyl, data=mtcars)
   class(mdl2)
   # [1] "lm"
   mdl2
   # Call:
   # lm(formula = mpg ~ disp, data = mtcars)
   # Coefficients:
   # (Intercept)         disp  
   #    29.59985     -0.04122  
   

2. 您应该得到一个错误，您应该在您的问题中逐字包含该问题。在这种情况下，我看到unexpected ')' in ...。我找到了lm(y()~)。您需要因变量或至少需要 1，将其更改为 lm(y()~1) 可修复该错字。

3. 在这里（还）不会压垮你，但是在使用它们之前require 你的反应变量是稳定的而不是NULL 是一个很好的做法。至少阅读?req；如需更多控制和用户友好性，请阅读?validate。

看看这是否效果更好：

library(shiny)

ui <- fluidPage(
  headerPanel('Fitting a curve'),
  sidebarPanel(
    selectInput(inputId = "xcol",label = "X-Axis",choices = names(mtcars)),
    selectInput(inputId = "ycol",label = "Y-Axis",choices = names(mtcars),selected = names(mtcars)[[3]]),
    sliderInput(inputId = "degree",label = "Degree of fit",min = 0,max = 2,value = 0)
  ),
  mainPanel(plotOutput("plot1"))

)

server <- function(input,output){
  x <- reactive({mtcars[,input$xcol]})
  y <- reactive({mtcars[,input$ycol]})
  z <- reactive({
    req(input$degree, x(), y())
    if (input$degree == 0) {
      lm(y() ~ 1)
    } else if (input$degree == 1) {
      lm(y() ~ x())
    } else lm(y() ~ x() + x()^2)
  })         
  output$plot1 <- renderPlot({
    plot(x(),y(),col = "red")
    abline(z())
  })

}

shinyApp(ui = ui,server = server)

Answer 2

这是你想要的吗？

library(shiny)

ui <- fluidPage(
    headerPanel('Fitting a curve'),
    sidebarPanel(
        selectInput(inputId = "xcol",label = "X-Axis",choices = names(mtcars)),
        selectInput(inputId = "ycol",label = "Y-Axis",choices = names(mtcars),selected = names(mtcars)[[3]]),
        sliderInput(inputId = "degree",label = "Degree of fit",min = 0,max = 2,value = 0)
    ),
    mainPanel(
        plotOutput("plot1")
        )

)

server <- function(input,output){

    x <- reactive({
        mtcars[,input$xcol]
    })

    y <- reactive({
        mtcars[,input$ycol]
    })

    z <- reactive({
        if(input$degree==0){
            return(lm(y()~1))
        }else if(input$degree == 1){
            return(lm(y()~x()))
        }else{
            return(lm(y()~x()+x()^2))
        }
    })

    output$plot1 <- renderPlot({
        plot(x(),y(),col = "red")
        abline(z())
    })

}

shinyApp(ui = ui,server = server)