闪亮的应用程序用户输入引发警告：“无效因子级别”

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 <- 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)