问题描述
因此，我试图创建一个用户界面，使该人员单击某个人可能患有的疾病的复选框，它会运行在先前开发的预测模型中，然后输出该预测。但是，我不断收到服务器中混淆矩阵代码的错误（不可分配）。我不确定自己做错了什么，因为我将其作为对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"),checkBoxGroupInput("Athero","Atherosclerosis:",c("Yes" = "yes2","No" = "no2"),selected = NULL))),p(),fluidRow(
column(4,checkBoxGroupInput("Sickle","Sickle Cell Anemia:",c("Yes" = "yes3","No" = "no3"),checkBoxGroupInput("Other","Other Infection:",c("Yes" = "yes4","No" = "no4"),checkBoxGroupInput("Spinal","Spinal Cord Injury:",c("Yes" = "yes5","No" = "no5"),checkBoxGroupInput("Obese","Obesity:",c("Yes" = "yes6","No" = "no6"),checkBoxGroupInput("Age","Age Group:",c("Infant" = "Infant","Child" = "Child","Adolescent"="Adolescent","Young Adult"="Young","Adult"="Adult","Middle Aged"="Middle","Senior"="Senior","Elder"="Elder"),checkBoxGroupInput("Sex","Sex:",c("Female" = "yes7","Male" = "no7"),checkBoxGroupInput("Impact","Spinal Impact from Occupation:",c("Low" = "low","Medium" = "medium","High"="high"),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",'No')
})
c<- eventReactive(input$Athero,{
c = ifelse(input$Athero == "yes2",'No')
})
d<- eventReactive(input$Sickle,{
d = ifelse(input$Sickle == "yes3",'No')
})
e<- eventReactive(input$Other,{
e = ifelse(input$Other == "yes4",'No')
})
f<- eventReactive(input$Spinal,{
f = ifelse(input$Spinal == "yes5",'No')
})
g<- eventReactive(input$Obese,{
g = ifelse(input$Obese == "yes6",'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",'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
解决方法
这是我将如何做的草图（我未包含所有输入）：
library(shiny)
library(DT)
ui <- fluidPage(
# Application title
titlePanel("Intervertebral Disc Degeneration Risk Prediction"),sidebarLayout(
sidebarPanel(
fluidRow(
column(4,checkboxGroupInput("Smoke","Smoking:",c("Yes" = "yes","No" = "no"),selected = NULL)),column(4,checkboxGroupInput("Diabete","Diabetes:",checkboxGroupInput("Athero","Atherosclerosis:",selected = NULL))),p(),fluidRow(
column(4,checkboxGroupInput("Sickle","Sickle Cell Anemia:",c("Yes" = "yes3","No" = "no3"),checkboxGroupInput("Other","Other Infection:",c("Yes" = "yes4","No" = "no4"),checkboxGroupInput("Spinal","Spinal Cord Injury:",c("Yes" = "yes5","No" = "no5"),# 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) {
final_data <- eventReactive(input$button,{
# create the df for the new test data
test_data <- data.frame(Smoking = input$Smoke,Diabetes = input$Diabete,...)
# make the prediction
predicted_value <- predict(super_model,newdata = test_data)
# bind the data together and return it
cbind(test_data,Risk = predicted_value)
})
output$summary_table <- renderDT(final_data()[,-which(colnames(final_data()) == "Risk")])
output$confusion_matrix <- renderText({
confusionMatrix(final_data())
})
}
# Run the application
shinyApp(ui = ui,server = server)