光り輝くアプリのgbmモデル式に対する反応的な反応変数

Question

私はユーザーが自分のデータをアップロードしてgbmモデルを実行できるようにする光沢のあるアプリを持っています。アップロードされたデータベースは、すべての予測変数と応答変数のデータフレームになります。これには、応答変数を反応入力として入力するか、列名のリストから選択する必要があります。

library(shiny) 
library(gbm) 


ui <- fluidPage(
    fluidRow(
    column(3,textInput("response","Enter the response variable",value="Petal.Width")), 
    column(9,verbatimTextOutput("summary")) 
) 
) 
server <- function(input, output, session) { 


    output$summary <- renderPrint({ 
model<-gbm(input$response~., data=iris, 
       distribution="gaussian", 
       bag.fraction=.5, 
       n.trees=1000, 
       interaction.depth=4, 
       shrinkage=0.01, 
       n.minobsinnode=10, 
       verbose=FALSE) 
    summary(model) 

    }) 



} 


shinyApp(ui=ui,server=server) 

しかし、私は、変数の長さは、エラーが異なり得る：ここで私は、これまでにしようとしているされているもの

Warning: Error in model.frame.default: variable lengths differ (found for 'Sepal.Length') 
Stack trace (innermost first): 
    90: model.frame.default 
    89: model.frame 
    88: eval 
    87: eval 
    86: gbm 
    85: renderPrint [D:/Dropbox/PhD/Nitrate Mapping Project/USGS Project/SOPs and Test Data/1SE SOP/gbm_reac_response.R#15] 
    84: func 
    83: eval 
    82: eval 
    81: withVisible 
    80: evalVis 
    79: utils::capture.output 
    78: paste 
    77: origRenderFunc 
    76: output$summary 
    1: runApp 

Answer 1

あなたがに渡すためformulaオブジェクトにユーザーの入力を変換するreactive()オブジェクトを使用することができますgbm()。このようなものは機能します....

library(shiny) 
library(gbm) 


ui <- fluidPage(
    fluidRow(
     column(3,textInput("response","Enter the response variable", 
          value="Petal.Width")), 
     column(9,verbatimTextOutput("summary")) 
    ) 
) 
server <- function(input, output, session) { 

    f <- reactive({ as.formula(paste(input$response, "~ .")) }) 

    output$summary <- renderPrint({ 
     model<-gbm(f(), data=iris, 
        distribution="gaussian", 
        bag.fraction=.5, 
        n.trees=1000, 
        interaction.depth=4, 
        shrinkage=0.01, 
        n.minobsinnode=10, 
        verbose=FALSE) 
     summary(model) 

    }) 

} 


shinyApp(ui=ui,server=server)