Блестящий пакет в R

Question

Я практикую блестящий пакет в R. Я создавал приложение, в котором пользователь выбирает две переменные и определяет степень кривой, которая должна соответствовать соответствующей диаграмме рассеяния. Для этого я использую данные mtcars. Я использовал команду selectinput для получения переменных. Я хочу, чтобы команда sliderinput определяла степень подгонки кривой. Код вроде работает, за исключением команды sliderinput.

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. Здесь вас не сокрушают (пока), но рекомендуется req uire ваши реактивные переменные стабильны, а не 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)