我正在尝试使用我在R中训练过的随机森林模型(“ rffit.rda”)使用发亮的方法来生成风险计算器。类似于此网络应用计算器]
https://sorg-apps.shinyapps.io/thaopioid/
但是我的应用程序中的预测面板没有任何输出。我可以使代码在常规R环境中在Shiny之外执行,但是当我将预测和解释功能添加到服务器端时,运行该应用程序时什么也没出现。感谢您的帮助。
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)
您是否尝试了observeEvent而不是反应式?