ralgorithmshinymodelpredictive

I keep getting Error in $: object of type 'closure' is not subsettable


So I am trying to create a user interface where the person clicks a checkbox for a disease that they may have, it runs through a previously developed predictive model, and then outputs that prediction. However, I keep getting an error (not subsettable) for the confusion matrix code in the server. I am not sure what I am doing wrong, as I made it a reactive for the function data1. Is the problem because I don't have a column for Risk because that is what I am using my model to predict. Do I need to make a column for it but have it empty? Hope this makes sense!

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)

The original code/model:

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

Solution

  • Here is a sketch how I would do it (I haven't included all inputs):

    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:",
                                      c("Yes" = "yes",
                                        "No" = "no"), selected = NULL)),
            column(4, 
                   checkboxGroupInput("Athero", "Atherosclerosis:",
                                      c("Yes" = "yes",
                                        "No" = "no"), 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))),
        ,
        
        # 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)