Блестящий plotOutput с plot_features из пакета извести ничего не дает - PullRequest
Новая
       82

Блестящий plotOutput с plot_features из пакета извести ничего не дает

0 голосов
/ 17 марта 2020

Я пытаюсь использовать «блестящий» для создания калькулятора риска, используя модель случайного леса, которую я обучил в R («rffit.rda»). похож на этот калькулятор веб-приложения

https://sorg-apps.shinyapps.io/thaopioid/

Но панель прогнозирования в моем приложении не дает мне выходных данных. Мне удалось заставить код работать вне блеска в обычной среде R, но когда я добавляю функции предсказания и объяснения на стороне сервера, при запуске приложения ничего не появляется. Благодарен за любую помощь. 

library(shinydashboard)
library(lime)
library(caret)
library(dplyr)
load("rffit.rda")
ui <- dashboardPage(
  dashboardHeader(title = "Postoperative Opioid Consumption Risk Calculator", 
                  titleWidth = 500),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Welcome", tabName = "welcome", icon = icon("dashboard")),
      menuItem("Input", tabName = "input", icon = icon("th")),
      menuItem("Prediction", tabName = "predictions", icon= icon("th"))
    )
  ),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "welcome",
              h2("Disclaimer"),
              h3(strong("This tool is designed for general educational purposes only and is not intended in any way to substitute
                    for professional medical advice, consultation, diagnosis, or treatment. Any analysis, report, or information
                    contained in or produced by this tool is intended to serve as a supplement to, and not a substitute for the knowledge, 
                    expertise, skill and judgment of health care professionals. In no event shall this tool under this Agreement, 
                    be considered to be in any form, medical care, treatment, or therapy for patients or users of this tool.")),
              h3("This tool's services are provided 'as is'. These services provide no warranties, express or implied and shall not be
             liable for any direct, consequential, lost profits, or other damages incurred by the user of this information tool.")
            ),

      # Second tab content
      tabItem(tabName = "input",
              selectInput("preop_narc", "Opioid use during the preoperative period (1 year to 30 days before surgery); 1=Yes, 0=No", 
                          choices = c("1", "0"), selected = "Yes"),
              numericInput("periop_ome", "Total morphine equivalent consumed during the perioperative period (30 days before surgery to 15 days after)", min = 0, value = 0),
              numericInput("unemployment", "Community percent unemployment", min = 0, value = 0),
              numericInput("med_inc", "Median household income($)", min = 0, value = 0),
              numericInput("hs", "Community percent high school graduate or GED obtained", min = 0, value = 0),
              numericInput("poverty", "Community percent living at poverty line", min = 0, value = 0),
              sliderInput("age", "Age", 0, 120, 0),
              sliderInput("preop_pain", "Preoperative pain", 0, 10, 0),
              numericInput("days_symptoms", "Days from symptom onset to surgery", min = 0, value = 0),
              actionButton("goButton", "Go!")
      ),
      # Third tab content
      tabItem(tabName = "predictions",
              plotOutput("explanations")
    )
  )
)
)
server <- function(input, output) {
  predictions <- eventReactive(input$goButton, {
  req(input$preop_narc, input$periop_ome, input$unemployement, input$med_inc, input$hs, input$poverty, input$age, input$preop_pain, input$days_symptoms)
  inputdata <- cbind(input$preop_narc, input$periop_ome, input$unemployement, input$med_inc, input$hs, input$poverty, input$age, input$preop_pain, input$days_symptoms)
  colnames(inputdata) <- c("narc", "preop_total_ome_1",
  "Percent__EMPLOYMENT_STATUS___Population_16_years_and_over___In_labor_force___Civilian_labor_force___Unemployed",
  "medinc", "Percent__Estimate__Percent_high_school_graduate_or_higher", "pov_100", "age_1", "Rate_your_pain_on_a_scale_from_1_10__1__minimal_pain__10__severe_pain__", "symptom_duration")
  inputdata$narc <-as.factor(inputdata$narc)
  training_set <- read.csv("training_set.csv")
  final_data <- rbind(training_set, inputdata)
  prediction = caret::predict(rffit, final_data, type = "raw")
  outputdata = cbind(final_data, prediction)
  outputdata
})

output$explanations <- renderPlot({
    pred = predictions()
    pred_1 <- lime(pred, rffit, bin_continuous = TRUE, quantile_bins = FALSE)
    pred_2 <- lime::explain(pred[1205,], pred_1, n_labels = 1, n_features = 9)
    pred_2$feature_desc <- c("Preoperative Opioid Use", 
                             "Perioperative 1 Year Opioid Consumption (OME)", 
                             "Percent unemployment", 
                             "Median income", 
                             "Percent high school graduate", 
                             "Percent living at poverty line", 
                             "Age", 
                             "Preoperative pain", 
                             "Duration of symptoms < 2Y")
    explain_plot <- plot_features(pred_2, ncol =1)
    explain_plot
})
}
shinyApp(ui, server)

1 Ответ

0 голосов
/ 18 марта 2020

Вы пробовали наблюдать за событием вместо реактивного?

...