r语言 - 闪亮应用用户输入抛出警告："无效因子水平"

Question

我正在开发一个R/Shiny应用程序，该应用程序需要9个用户输入，使用这些输入创建一个数据帧，将数据帧传递给predict()函数以及预训练的随机森林模型，然后返回概率或预测。

9个用户输入中的一个以单选按钮的形式出现，其结果在变量fever_input中被捕获。当我生成测试用户输入时，这个变量似乎会导致服务器抛出以下警告:

Warning in `[<-.factor`(`*tmp*`, iseq, value = 4L) :
  invalid factor level, NA generated

打印变量结果为[1] "Yes"。

尽管如此，当我调用str(test_df)(这是由具有9个变量的单个观测构建的数据框架)时，我看到fever为NA。结果如下:

'data.frame':   1 obs. of  9 variables:
 $ age               : int 23
 $ female            : Factor w/ 2 levels "0","1": 2
 $ white             : Factor w/ 2 levels "0","1": 2
 $ bmi               : num 33
 $ peak_bili_pre_ercp: num 1
 $ dm                : Factor w/ 2 levels "0","1": 2
 $ fever             : Factor w/ 2 levels "0","1": NA
 $ stone_on_any_comp : Factor w/ 2 levels "0","1": 2
 $ max_cbd_dia_noninv: num 9

有人知道发生了什么事吗?提前感谢!

下面的代码…

UI代码:

ui <- fluidPage(
  titlePanel("Does my patient have choledocholithiasis?"),
  fluidRow(
    column(4, 
        numericInput("age_input", label="Age: ", min = 18, max = 96, value = NULL),
        radioButtons("sex_input", "Sex", choices = c("Male", "Female")),
        selectInput("race_input", "Race", choices = c("White", "Hispanic", "African-American", "Asian", "Other")),
        numericInput("bmi_input", "BMI", min = 18, max = 75, value = NULL),
        numericInput("bili_input", "Peak total bilirubin", min = 3.84, max = 29.7, value = NULL)
    ),
    column(4, 
        radioButtons("dm_input", "Has diabetes", choices = c("Yes", "No")),
        radioButtons("fever_input", "Has fever", choices = c("Yes", "No")),
        radioButtons("stone_noninv_input", "Evidence of choledocholithiasis on US, CT, or MRCP", choices = c("Yes", "No")),
        numericInput("cbd_dia_input", "Maximum CBD diameter measured on US or MRCP", min = 3.58, max = 19, value = NULL)
    )
  ),
  fluidRow(
    column(8, 
        actionButton("submit_button", "Compute!", class = "btn-lg btn-success"),
        align = "center"
    )
  )
)

服务器:

server <- function(input, output) {
    print("Debug")
    observeEvent(input$submit_button, ({
        print("Button triggered")
        validate(
            need(input$age_input, 'Please enter an age.'),
            need(input$bmi_input, 'Please enter a BMI.'),
            need(input$bili_input, 'Please enter a bilirubin value.'),
            need(input$cbd_dia_input, 'Please enter a CBD diameter.')
        )
        test_df <- data.frame(age = integer(),
            female = factor(levels = c(0,1)),
            white = factor(levels = c(0,1)),
            bmi = double(),
            peak_bili_pre_ercp = double(),
            dm = factor(levels = c(0,1)),
            fever = factor(levels = c(0,1)),
            stone_on_any_comp = factor(levels = c(0,1)),
            max_cbd_dia_noninv = double(),
            stringsAsFactors = FALSE
        )
        print(input$fever_input)
        test_df[nrow(test_df)+1,] <- c(age = input$age_input,
                female = factor(ifelse(input$sex_input=="Female", 1, 0)),
                white = factor(ifelse(input$race_input=="White", 1, 0)),
                bmi = input$bmi_input,
                dm = factor(ifelse(input$dm_input=="Yes", 1, 0)),
                fever = factor(ifelse(input$fever_input=="Yes", 1, 0)),
                peak_bili_pre_ercp = input$bili_input,
                stone_on_any_comp = factor(ifelse(input$stone_noninv_input=="Yes", 1, 0)),
                max_cbd_dia_noninv = input$cbd_dia_input
        )
        str(test_df)
        print(test_df)
    })
    )  
}

Answer 1

• 不要创建空的数据框并添加行
• 我不知道为什么你需要变量作为因素，但我一直保持它们的原样。
• ifelse(condition, 1, 0)可以简化为as.integer(condition)。
• 在server函数中，我打印print(test_df)，以便您可以看到创建的数据帧。

library(shiny)
ui <- fluidPage(
  titlePanel("Does my patient have choledocholithiasis?"),
  fluidRow(
    column(4, 
           numericInput("age_input", label="Age: ", min = 18, max = 96, value = NULL),
           radioButtons("sex_input", "Sex", choices = c("Male", "Female")),
           selectInput("race_input", "Race", choices = c("White", "Hispanic", "African-American", "Asian", "Other")),
           numericInput("bmi_input", "BMI", min = 18, max = 75, value = NULL),
           numericInput("bili_input", "Peak total bilirubin", min = 3.84, max = 29.7, value = NULL)
    ),
    column(4, 
           radioButtons("dm_input", "Has diabetes", choices = c("Yes", "No")),
           radioButtons("fever_input", "Has fever", choices = c("Yes", "No")),
           radioButtons("stone_noninv_input", "Evidence of choledocholithiasis on US, CT, or MRCP", choices = c("Yes", "No")),
           numericInput("cbd_dia_input", "Maximum CBD diameter measured on US or MRCP", min = 3.58, max = 19, value = NULL)
    )
  ),
  fluidRow(
    column(8, 
           actionButton("submit_button", "Compute!", class = "btn-lg btn-success"),
           align = "center"
    )
  )
)

server <- function(input, output) {
  print("Debug")
  
  observeEvent(input$submit_button, ({
    print("Button triggered")
    
    validate(
      need(input$age_input, 'Please enter an age.'),
      need(input$bmi_input, 'Please enter a BMI.'),
      need(input$bili_input, 'Please enter a bilirubin value.'),
      need(input$cbd_dia_input, 'Please enter a CBD diameter.')
    )
    
   
    
    test_df <- data.frame(age = input$age_input,
              female = factor(as.integer(input$sex_input=="Female")),
              white = factor(as.integer(input$race_input=="White")),
              bmi = input$bmi_input,
              dm = factor(as.integer(input$dm_input=="Yes")),
              fever = factor(as.integer(input$fever_input=="Yes")),
              peak_bili_pre_ercp = input$bili_input,
              stone_on_any_comp = factor(as.integer(input$stone_noninv_input=="Yes")),
              max_cbd_dia_noninv = input$cbd_dia_input
    )
    print(test_df)
  })
  )  
}
shinyApp(ui, server)