我正在尝试学习在R中构建基于机器学习的Shiny界面。我花了几个小时试图解决这个“参数10为空”的错误,但一直没能找到解决办法。我的代码遵循了来自Github的@dataprofessor创建的结构。我非常感谢任何建议、提示和纠正。谢谢!
这是我的代码:
# 导入库
library(shiny)
library(data.table)
library(randomForest)
library(caret)
library(mlbench)
data("Glass")
# 读取RF模型
model <- readRDS("model.rds")
# 训练集
set.seed(345)
train.index=createDataPartition(Glass[,ncol(Glass)],p=0.7,list=FALSE)
train=Glass[train.index,]
#####################################
# 用户界面
#####################################
ui <- pageWithSidebar(
# 页面头部
headerPanel('玻璃类型预测器'),
# 输入值
sidebarPanel(
HTML("<h3>输入参数</h4>"),
sliderInput("RI", label = "折射率", value = mean(train$RI),
min = min(train$RI),
max = max(train$RI)),
sliderInput("Na", label = "钠", value = mean(train$Na),
min = min(train$Na),
max = max(train$Na)),
sliderInput("Mg", label = "镁", value = mean(train$Mg),
min = min(train$Mg),
max = max(train$Mg)),
sliderInput("Al", label = "铝", value = mean(train$Al),
min = min(train$Al),
max = max(train$Al)),
sliderInput("Si", label = "硅", value = mean(train$Si),
min = min(train$Si),
max = max(train$Si)),
sliderInput("K", label = "钾", value = mean(train$K),
min = min(train$K),
max = max(train$K)),
sliderInput("Ca", label = "钙", value = mean(train$Ca),
min = min(train$Ca),
max = max(train$Ca)),
sliderInput("Ba", label = "钡", value = mean(train$Ba),
min = min(train$Ba),
max = max(train$Ba)),
sliderInput("Fe", label = "铁", value = mean(train$Fe),
min = min(train$Fe),
max = max(train$Fe)),
actionButton("submitbutton", "提交", class = "btn btn-primary")
),
mainPanel(
tags$label(h3('状态/输出')), # 状态/输出文本框
verbatimTextOutput('contents'),
tableOutput('tabledata') # 预测结果表
))
#####################################
# 服务器
#####################################
server<- function(input, output, session) {
# 输入数据
datasetInput <- reactive({
df <- data.frame(
Name = c("折射率",
"钠",
"镁",
"铝",
"硅",
"钾",
"钙",
"钡",
"铁"),
Value = as.character(c(input$RI,
input$Na,
input$Mg,
input$Al,
input$Si,
input$K,
input$Ca,
input$Ba,
input$Fe,)),
stringsAsFactors = FALSE)
Type <- 5
df <- rbind(df, Type)
input <- transpose(df)
write.table(input,"input.csv", sep=",", quote = FALSE, row.names = FALSE, col.names = FALSE)
test <- read.csv(paste("input", ".csv", sep=""), header = TRUE)
Output <- data.frame(Prediction=predict(model,test), round(predict(model,test,type="prob"), 3))
print(Output)
})
# 状态/输出文本框
output$contents <- renderPrint({
if (input$submitbutton>0) {
isolate("计算完成。")
} else {
return("服务器已准备好进行计算。")
}
})
# 预测结果表
output$tabledata <- renderTable({
if (input$submitbutton>0) {
isolate(datasetInput())
}
})
}
#####################################
# 创建Shiny应用
#####################################
shinyApp(ui = ui, server = server)
这是model.RDS的代码
library(randomForest)
library(mlbench)
data("Glass")
###########################################################################################################################################
# 随机分割为训练集和测试集
##################
set.seed(345)
train.index=createDataPartition(Glass[,ncol(Glass)],p=0.7,list=FALSE)
train=Glass[train.index,]
test=Glass[-train.index,]
##########################################################################
# 随机森林模型
#######################################################################################################################################################################
model <- randomForest(Type ~ ., data = train, ntree = 500, mtry = 9, importance = TRUE)
model
# 保存模型到RDS文件
saveRDS(model, "model.rds")
回答:
最初的问题是由input$Fe
后的一个多余逗号引起的。这导致了第二个问题,即代码所需的test
数据框的名称与从输入值构建的名称不匹配。我还需要在构建模型时添加对library(caret)
的调用。现在它可以运行了,我可以看到Type
被传递到预测调用中。不确定为什么需要这个,因为预测试图得出Type
,所以我删除了它。我还删除了input.csv
文件的创建,直接创建了测试数据框。
这是完整的app.R
。
library(shiny)
library(data.table)
library(randomForest)
library(caret)
library(mlbench)
data("Glass")
# 读取RF模型
model <- readRDS("model.rds")
# 训练集
set.seed(345)
train.index=createDataPartition(Glass[,ncol(Glass)],p=0.7,list=FALSE)
train=Glass[train.index,]
#####################################
# 用户界面
#####################################
ui <- pageWithSidebar(
# 页面头部
headerPanel('玻璃类型预测器'),
# 输入值
sidebarPanel(
HTML("<h3>输入参数</h3>"),
sliderInput("RI", label = "折射率", value = mean(train$RI),
min = min(train$RI),
max = max(train$RI)),
sliderInput("Na", label = "钠", value = mean(train$Na),
min = min(train$Na),
max = max(train$Na)),
sliderInput("Mg", label = "镁", value = mean(train$Mg),
min = min(train$Mg),
max = max(train$Mg)),
sliderInput("Al", label = "铝", value = mean(train$Al),
min = min(train$Al),
max = max(train$Al)),
sliderInput("Si", label = "硅", value = mean(train$Si),
min = min(train$Si),
max = max(train$Si)),
sliderInput("K", label = "钾", value = mean(train$K),
min = min(train$K),
max = max(train$K)),
sliderInput("Ca", label = "钙", value = mean(train$Ca),
min = min(train$Ca),
max = max(train$Ca)),
sliderInput("Ba", label = "钡", value = mean(train$Ba),
min = min(train$Ba),
max = max(train$Ba)),
sliderInput("Fe", label = "铁", value = mean(train$Fe),
min = min(train$Fe),
max = max(train$Fe)),
actionButton("submitbutton", "提交", class = "btn btn-primary")
),
mainPanel(
tags$label(h3('状态/输出')), # 状态/输出文本框
verbatimTextOutput('contents'),
tableOutput('tabledata') # 预测结果表
))
#####################################
# 服务器
#####################################
server<- function(input, output, session) {
# 输入数据
datasetInput <- reactive({
df <- data.frame(
Name = c("RI",
"Na",
"Mg",
"Al",
"Si",
"K",
"Ca",
"Ba",
"Fe"),
Value = as.character(c(input$RI,
input$Na,
input$Mg,
input$Al,
input$Si,
input$K,
input$Ca,
input$Ba,
input$Fe)),
stringsAsFactors = FALSE)
input <- transpose(df)
test = input[2,]
names(test) = as.character(input[1,])
Output <- data.frame(Prediction=predict(model,test), round(predict(model,test,type="prob"), 3))
Output
})
# 状态/输出文本框
output$contents <- renderPrint({
if (input$submitbutton>0) {
isolate("计算完成。")
} else {
return("服务器已准备好进行计算。")
}
})
# 预测结果表
output$tabledata <- renderTable({
if (input$submitbutton>0) {
isolate(datasetInput())
}
})
}
#####################################
# 创建Shiny应用
#####################################
shinyApp(ui = ui, server = server)