因此，我正在尝试创建一个用户界面，人们可以在其中单击他们可能患有的疾病的复选框，它会运行先前开发的预测模型，然后输出该预测。但是，我不断收到服务器中混淆矩阵代码的错误（不是子集）。我不确定我做错了什么，因为我把它变成了函数 data1 的反应式。问题是因为我没有风险列，因为那是我使用我的模型来预测的。我是否需要为它创建一列但将其留空？希望这是有道理的！
library(shiny)
library(DT)
ui <- fluidPage(
# Application title
titlePanel("Intervertebral Disc Degeneration Risk Prediction"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(4,
checkboxGroupInput("Smoke", "Smoking:",
c("Yes" = "yes0",
"No" = "no0"), selected = NULL)),
column(4,
checkboxGroupInput("Diabete", "Diabetes:",
c("Yes" = "yes1",
"No" = "no1"), selected = NULL)),
column(4,
checkboxGroupInput("Athero", "Atherosclerosis:",
c("Yes" = "yes2",
"No" = "no2"), selected = NULL))),
p(),
fluidRow(
column(4,
checkboxGroupInput("Sickle", "Sickle Cell Anemia:",
c("Yes" = "yes3",
"No" = "no3"), selected = NULL)),
column(4,
checkboxGroupInput("Other", "Other Infection:",
c("Yes" = "yes4",
"No" = "no4"), selected = NULL)),
column(4,
checkboxGroupInput("Spinal", "Spinal Cord Injury:",
c("Yes" = "yes5",
"No" = "no5"), selected = NULL))),
p(),
fluidRow(
column(4,
checkboxGroupInput("Obese", "Obesity:",
c("Yes" = "yes6",
"No" = "no6"), selected = NULL)),
column(4,
checkboxGroupInput("Age", "Age Group:",
c("Infant" = "Infant",
"Child" = "Child",
"Adolescent"="Adolescent",
"Young Adult"="Young",
"Adult"="Adult",
"Middle Aged"="Middle",
"Senior"="Senior",
"Elder"="Elder"), selected = NULL)),
column(4,
checkboxGroupInput("Sex", "Sex:",
c("Female" = "yes7","Male" = "no7"), selected = NULL))),
p(),
fluidRow(
column(4,
checkboxGroupInput("Impact", "Spinal Impact from Occupation:",
c("Low" = "low",
"Medium" = "medium",
"High"="high"), selected = NULL)),
column(4,
checkboxGroupInput("Fusion", "Spinal Fusion:",
c("Yes" = "yes8",
"No" = "no8"), selected = NULL)))),
# Show a plot of the generated distribution
mainPanel(
fluidRow(actionButton("button", "Click for Risk Prediction")),
dataTableOutput("summary_table"),
verbatimTextOutput('confusion_matrix')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observeEvent(input$button, {
a<- eventReactive(input$Smoke, {
a = ifelse(input$Smoke == "yes0",'Yes','No')
})
b<- eventReactive(input$Diabete, {
b = ifelse(input$Diabete == "yes1",'Yes','No')
})
c<- eventReactive(input$Athero, {
c = ifelse(input$Athero == "yes2",'Yes','No')
})
d<- eventReactive(input$Sickle, {
d = ifelse(input$Sickle == "yes3",'Yes','No')
})
e<- eventReactive(input$Other, {
e = ifelse(input$Other == "yes4",'Yes','No')
})
f<- eventReactive(input$Spinal, {
f = ifelse(input$Spinal == "yes5",'Yes','No')
})
g<- eventReactive(input$Obese, {
g = ifelse(input$Obese == "yes6",'Yes','No')
})
h<- eventReactive(input$Age, {
h = ifelse(input$Age == "Infant",'Infant',
ifelse(input$Age == "Child", 'Child',
ifelse(input$Age == "Adolescent", 'Adolescent',
ifelse(input$Age == "Young",'Young Adult',
ifelse(input$Age == "Adult", 'Adult',
ifelse(input$Age == "Middle",'Middle Aged',
ifelse(input$Age =="Senior", 'Senior',
ifelse(input$Age == "Elder",'Elder', 'none')))))))
)
})
i<- eventReactive(input$Sex, {
i = ifelse(input$Sex == "yes7",'Female','Male')
})
j<- eventReactive(input$Impact, {
j = ifelse(input$Impact == "low",'Low',
ifelse(input$Impact == "medium", 'Medium',
ifelse(input$Impact == "high", 'High', 'none')))
})
k<- eventReactive(input$Fusion, {
k = ifelse(input$Fusion == "yes8",'Yes','No')
})
ivd<- data.frame(a='Smoking',b='Diabetes',c='Atherosclerosis',d='Sickle_Cell_Anemia',
e='Other_Infection',f='Spinal_Cord_Injury',g='Obesity',
h='Age_Group',i='Sex',j='Spinal_Impact',k='Spinal_Fusion_Surgery')
data1 <- reactive({
data <- rbind(ivd,data.frame(a=a(),b=b(),c=c(),d=d(),e=e(),f=f(),
g=g(),h=h(),i=i(),j=j(),k=k()))
})
data1
output$summary_table <- renderDT(data1())
final_predictions <- reactive({predict(super_model, newdata = data1())})
output$confusion_matrix <- renderText({
confusionMatrix(data1(),data1$Risk)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
原始代码/模型：
set.seed(1992)
Split201 <- createDataPartition(balanced.data$Risk,p=0.85,list=FALSE)
training_data201 = balanced.data[Split201,]
testing_data201 = balanced.data[-Split201,]
control <- trainControl(savePredictions=T,classProbs=T,summaryFunction=multiClassSummary)
lr_fit <- train(Risk ~ Obesity + Sickle_Cell_Disease + Atherosclerosis + Spinal_Fusion + Impact + Diabetes + Gender + Age_Group + Spinal_Cord_Injury + Other_Infection + Smoking + Height,
data=training_data201, method = "glm", trControl = control,metric='ROC')
lr_predict = predict(lr_fit,newdata=testing_data201)
confusionMatrix(testing_data201$Risk, lr_predict)
confusionMatrix(testing_data201$Risk, lr_predict, mode = "prec_recall")
table(testing_data201$Risk, lr_predict)
saveRDS(lr_fit, "./lr_fit.rds")
#load the model
super_model <- readRDS("./lr_fit.rds")
print(super_model)
#make predictions on new models
final_predictions <- predict(super_model, newdata = balanced.data )
final_predictions