预测值不响应用户输入 R Shiny
Prediction values not reacting to user inputs Rshiny
我正在尝试构建一个闪亮的应用程序,它可以根据各种用户输入给出新的预测。
但是,即使输入值随着输入而更新,预测值也不会更新。我不知道为什么。
该模型是一个随机森林回归模型,在示例中我使用的是数字变量,但在我的情况下输入是分类的(我认为这种变化不会产生任何影响)这就是为什么侧边栏都是 select 输入而不是 select 数字
我用 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) 您使用的 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)
我正在尝试构建一个闪亮的应用程序,它可以根据各种用户输入给出新的预测。 但是,即使输入值随着输入而更新,预测值也不会更新。我不知道为什么。
该模型是一个随机森林回归模型,在示例中我使用的是数字变量,但在我的情况下输入是分类的(我认为这种变化不会产生任何影响)这就是为什么侧边栏都是 select 输入而不是 select 数字
我用 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) 您使用的 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)