Прогнозные значения не реагируют на пользовательские входы Rshiny - PullRequest
Новая
       68

Прогнозные значения не реагируют на пользовательские входы Rshiny

0 голосов
/ 07 февраля 2019

Я пытаюсь создать блестящее приложение, которое дает новые прогнозы, основанные на различных пользовательских входах.Однако даже если входные значения обновляются вместе с входными данными, значение прогнозирования не обновляется.У меня возникли проблемы с выяснением причины.

Модель представляет собой модель регрессии случайных лесов, в примере я использую числовые переменные, но в моей ситуации входные данные являются категоричными (я не думаю, что это изменение должно повлиять на что-либо)Вот почему на боковой панели есть все входные данные, а не числовые

Я сделал воспроизводимый пример с набором данных mtcars 

model <- ranger(mpg ~ disp + hp + wt, data = mtcars)



ui <- fluidPage(
  sidebarPanel(
    selectInput('disp', 'disp',
              choices = unique(mtcars$disp),
            selected = unique(mtcars$disp)[1]),
selectInput('hp', 'hp',
            choices = unique(mtcars$hp),
            selected = unique(mtcars$hp)[1]),
selectInput('wt', 'wt',
            choices = unique(mtcars$wt)),
actionButton("Enter", "Enter Values"),
width = 2
  ),
  mainPanel(
tableOutput('mpg')
)
)

server <- function(input, output, session) {




  val <- reactive({

new <- mtcars[1, ]
new$disp <- input$disp
new$hp <- input$hp
new$wt <- input$wt

new
  })

  out <- eventReactive(
    input$Enter,
    {
      val <- val()
      val$pred <- predict(model, data = val)$predictions
      val

    })

  output$mpg <- renderTable({


    out()

  })


}

shinyApp(ui, server)

1 Ответ

0 голосов
/ 07 февраля 2019

Здесь есть несколько проблем.

1) Вы неправильно используете selectInput.Увидеть ниже.По сути, использование таких индексов, как mtcars $ disp [1], создаст статические значения, независимо от того, что выбрано.

2) Вы используете renderTable (), когда вы выводите только одно значение в качестве вывода.Почему бы просто не использовать renderText ()?См. Ниже.

3) Триггер eventReactive (т. Е. Input $ enter) необходимо использовать для создания фрейма данных с входными значениями.Прогноз модели может быть запущен на фрейме данных позже, но первоначальный триггер фактически извлекает значения из selectInput, поэтому триггер должен находиться в том же блоке, где создан фрейм данных.

Это выполнено правильно и произведеножелаемый вывод на моей машине: 

library(shiny)
library(ranger)

model <- ranger(mpg ~ disp + hp + wt, data = mtcars)

ui <- fluidPage(

        sidebarPanel(

                selectInput('disp', 'disp',
                            unique(mtcars$disp)),

                selectInput('hp', 'hp',
                            unique(mtcars$hp)),

                selectInput('wt', 'wt',
                            unique(mtcars$wt)),

                actionButton("enter", label = "Enter Values"),
                width = 2
        ),

        mainPanel(

                textOutput('mpg')

        )

)

server <- function(input, output, session) {

        val <- eventReactive(

                input$enter, {

                data.frame(

                        disp = input$disp,
                        hp = input$hp,
                        wt = input$wt,
                        stringsAsFactors = F

                )}

        )

        output$mpg <- renderText({

                predict(model, val())[[1]]

        })

}

shinyApp(ui, server)
...