插件Caret和Shiny：无法创建由Caret模型驱动的预测应用程序

Question

我正在尝试在shiny中编写一个简单的应用程序，根据乘客的年龄、等级、费用等预测他们在泰坦尼克号上生存的概率。我希望这些变量是动态的，并且想要使用基础caret模型来计算预测的生存概率。

运行此代码时，我收到以下错误消息：

警告：Error in [.data.frame: undefined columns selected Stack trace (innermost first): 70: [.data.frame 69: [ 68: sweep 67: predict.preProcess 66: predict 65: probFunction 64: predict.train 63: predict 62: predict 61: is.data.frame 60: data.matrix 59: observerFunc [#17] 4: 3: do.call 2: print.shiny.appobj 1: ERROR: [on_request_read] connection reset by peer

我的代码如下。有什么想法是导致这个错误的原因吗？非常感谢。

require(shiny)
require(plyr)
require(dplyr)
require(ggplot2)
require(caret)
require(xgboost)

require(titanic)
df=na.omit(titanic_train)
y=data.matrix(select(df, Survived))
y[y==0]="N"
y[y==1]="Y"
x=data.matrix(select(df, Pclass, Age, SibSp, Parch, Fare))

tCtrl <- trainControl(method = "repeatedcv", number = 3, repeats=3, summaryFunction = twoClassSummary, verbose=TRUE, classProbs = TRUE)
fit_xgbTree= train(x, y, method = "xgbTree" , family= "binomial", trControl = tCtrl, metric = "ROC", preProc = c("center", "scale"))

ui = pageWithSidebar(
  headerPanel("Titanic"),
  sidebarPanel(
    radioButtons("Pclass", "Passenger Class", choices=c("1", "2", "3"),selected = "1", inline = TRUE,width = NULL),
    sliderInput("Age", "Passenger Age", min=0, max=80, value=30),
    radioButtons("SibSp", "SibSp", choices=c("0", "1", "2", "3", "4", "5")),
    radioButtons("Parch", "Parch", choices=c("0", "1", "2", "3", "4", "5", "6")),
    sliderInput("Fare", "Passenger Fare", min=0, max=520, value=35)
  ),
  mainPanel(
    dataTableOutput('testTable'),
    textOutput('outputBox')
  )
)

server=function(input, output){

  values <- reactiveValues()

  newEntry <- observe({ # use observe pattern

    x=as.data.frame(matrix(0, nrow=1, ncol=5))
    colnames(x)=c("Pclass", "Age",    "SibSp", "Parch",  "Fare")

    x[1,1]=as.numeric(input$Pclass)
    x[1,2]=input$Age
    x[1,3]=as.numeric(input$SibSp)
    x[1,4]=as.numeric(input$Parch)
    x[1,5]=input$Fare


    pred <- data.matrix(predict(object=fit_xgbTree, x, type="prob")[,2])
    isolate(values$df <- x)
    #isolate(values$df2 <- x)
  })

  output$testTable <- renderDataTable({values$df})
}

shinyApp(ui=ui, server=server)

- user3725021

---

我认为这可能是由NA引起的...在x[1,1]=as.numeric(input$Pclass)中，由于input$PClass的选择是“1st”，“2nd”，“3rd”，所以运行as.numeric会得到NAs。预测函数失败了。因此，您无法从预测函数返回矩阵，并且无法运行[,2]。 - Jean

Pclass 是数值型的。您可以通过运行 unique(df$Pclass) 来进行检查。 - user3725021

input$Pclass 是字符类型。 - Jean

啊，好的，谢谢。不过我还是遇到了类似的错误 - 我已经修改了问题以考虑 Pclass。 - user3725021

你的输出表格中不需要另外一列来显示预测结果（生存概率）吗？否则你的代码是正常工作的。 - Sandipan Dey

Answer 1

以下服务器的修改对我非常有效（添加了一个生存概率列，我认为这就是你想要的）：

server=function(input, output){

  values <- reactiveValues()

  newEntry <- observe({ # use observe pattern

    x=as.data.frame(matrix(0, nrow=1, ncol=6))
    colnames(x)=c("Pclass", "Age",    "SibSp", "Parch",  "Fare", "SurvProb")

    x[1,1]=as.numeric(input$Pclass)
    x[1,2]=input$Age
    x[1,3]=as.numeric(input$SibSp)
    x[1,4]=as.numeric(input$Parch)
    x[1,5]=input$Fare

    pred <- data.matrix(predict(object=fit_xgbTree, x[-length(x)], type="prob")[,2])
    x[1,6] <- round(pred,2)

    isolate(values$df <- x)
    #isolate(values$df2 <- x)
  })

  output$testTable <- renderDataTable({values$df})
}

使用输出

- Sandipan Dey