2016-04-16 3 views
0

R Shinyを使用することについて比較的新しいです、予測モデルのためのShinyアプリケーションを構築しようとしています。 私はRコードを準備してあり、R Shinyにそれらをロードしました。1番目の入力ファイルの結果が要件を満たしている場合にのみR Shinyの2番目のファイルを入力してください

私が準備したui.rとserver.rを参照してください。

shinyUI(
    fluidPage( 
    titlePanel("Prediction"), 
    sidebarLayout(  
     sidebarPanel(
     fileInput('file1', 'Choose Past CSV File', 
        accept=c('text/csv', 
          'text/comma-separated-values,text/plain', 
          '.csv')), 
     conditionalPanel(
      condition = "output.fileUploaded", 
      fileInput('file2', 'Choose Future CSV File', 
        accept=c('text/csv', 
          'text/comma-separated-values,text/plain', 
          '.csv')), 
      downloadButton("downloadData", "Download Prediction") 
     ) 
    ), 
     mainPanel(
     tabsetPanel(type = "tabs", 
        tabPanel('Results', (DT::dataTableOutput('table'))), 
     tabPanel("Model Summary", 
       verbatimTextOutput("summary")) 
    ) 
    ) 
    ) 
) 
) 

shinyServer(function(input, output) { 
    # hide the output 
    output$fileUploaded <- reactive({ 
    return(!is.null(input$file1)) 
    }) 
    outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE) 
    data <- reactive({ 
    File <- input$file1 
    if (is.null(File)) 
     return(NULL) 
    complete <- read.csv(File$datapath,header=T,na.strings=c("")) 
    File1 <- input$file2 
    if (is.null(File1)) 
     return(NULL) 
    raw.data <- read.csv(File1$datapath,header=T,na.strings=c("")) 
    #Change all variable to factor 
    complete[] <- lapply(complete, factor) 
    complete$Target <- recode(complete$Target," 'YES' = 1; 'Yes' = 1; 'NO' = 0 ") 
    set.seed(33) 
    splitIndex <- createDataPartition(complete$Target, p = .75, list = FALSE, times = 1) 
    trainData <- complete[ splitIndex,] 
    testData <- complete[-splitIndex,] 
    fitControl <- trainControl(method = "repeatedcv", number = 4, repeats = 4) 
    set.seed(33) 
    gbmFit1 <- train(as.factor(Target) ~ ., data = trainData, method = "gbm", trControl = fitControl,verbose = FALSE) 
    pred <- predict(gbmFit1, testData,type= "prob")[,2] 
    perf = prediction(pred, testData$Target) 
    pred1 = performance(perf, "tpr","fpr") 
    acc.perf <- performance(perf, "acc") 
    ind = which.max(slot(acc.perf, "y.values")[[1]]) 
    acc = slot(acc.perf, "y.values")[[1]][ind] 
    output$summary <- renderPrint({ 
     print(c(Accuracy=acc)) 
    }) 
    raw.data[] <- lapply(raw.data, factor) 
    testpred <- predict(gbmFit1, raw.data,type= "prob")[,2] 
    final = cbind(raw.data, testpred) 
    final 
    }) 
    output$table = DT::renderDataTable({ 
    final <- data() 
    DT::datatable(
     data(), options = list(
     pageLength = 5) 
    ) 
    }) 
    output$downloadData <- downloadHandler(
    filename = function() { paste('SLA Prediction', '.csv', sep='') }, 
    content = function(file) { 
     write.csv(data(),file) 
    } 
) 
    return(output) 
}) 

モデルは、最初の入力ファイルを使用して作成され、私の要件は、ユーザーである第一の入力ファイルを使用して計算モデルの精度は、変数ACCに保存されている場合にのみ、(彼らは結果を予測したい)第二の入力ファイルをアップロードする必要があります頼まなければなりません0.9以上であれば、私はこれのための解決策を得ることができません、誰もこれで私を助けることができます。

答えて

0

2番目のファイル入力は変数accに依存し、0.9より大きい場合にのみ表示されます。あなたのコードは私のラップトップでは動作しなかったので、私はさらにいくつかの変更を行いました:)。 return(NULL)の代わりに、関数reqを使用して値が使用可能であることを確認できます。

library(shiny) 
library(shinysky) 
library(shinythemes) 
library(caret) 
library(gbm) 
library(ROCR) 
library(car) 

ui <- shinyUI(
    fluidPage(
    theme = shinytheme("united"), # added new theme from the package 'shinythemes'  
    titlePanel("Prediction"), 
    sidebarLayout(  
     sidebarPanel(
     fileInput('file1', 'Choose Past CSV File', 
        accept=c('text/csv', 
          'text/comma-separated-values,text/plain', 
          '.csv')), 
     uiOutput("dynamic") 
    ), 
     mainPanel(
     # added busyIndicator 
     busyIndicator(text = "Calculation in progress..", 
         img = "shinysky/busyIndicator/ajaxloaderq.gif", wait = 500), 

     tabsetPanel(type = "tabs", 
        tabPanel('Results', 
         (DT::dataTableOutput('table'))), 
        tabPanel("Model Summary", 
         verbatimTextOutput("summary")), 
        tabPanel("Predictions", 
         DT::dataTableOutput('tablePred')) 
     ) 
    ) 
    ) 
) 
) 

server <- shinyServer(function(input, output) { 
    # hide the output 
    output$fileUploaded <- reactive({ 
    return(!is.null(input$file1)) 
    }) 
    outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE) 


    data <- reactive({ 
    File <- input$file1 
    req(File) 
    complete <- read.csv(File$datapath,header=T,na.strings=c("")) 
    complete 
    }) 

    model <- reactive({ 

    complete <- lapply(data(), factor) 
    complete$Target <- recode(data()$Target," 'YES' = 1; 'Yes' = 1; 'NO' = 0 ") 
    set.seed(33) 
    splitIndex <- createDataPartition(data()$Target, p = .75, list = FALSE, times = 1) 
    trainData <- data()[ splitIndex,] 
    testData <- data()[-splitIndex,] 
    fitControl <- trainControl(method = "repeatedcv", number = 4, repeats = 4) 
    set.seed(33) 
    gbmFit1 <- train(as.factor(Target) ~ ., data = trainData, method = "gbm", trControl = fitControl,verbose = FALSE) 
    pred <- predict(gbmFit1, testData, type= "prob")[,2] 
    perf = prediction(pred, testData$Target) 
    pred1 = performance(perf, "tpr","fpr") 
    acc.perf <- performance(perf, "acc") 
    ind = which.max(slot(acc.perf, "y.values")[[1]]) 
    acc = slot(acc.perf, "y.values")[[1]][ind] 
    retval <- list(model = gbmFit1, accuracy = acc) 
    return(retval) 
    }) 


    output$summary <- renderPrint({ 
    req(model()) 
    print(model()) 
    }) 


    output$dynamic <- renderUI({ 
    req(model()) 
    if (model()$accuracy >= 0.9) 
     list(
     fileInput('file2', 'Choose Future CSV File', 
       accept=c('text/csv', 
         'text/comma-separated-values,text/plain', 
         '.csv')), 
     downloadButton("downloadData", "Download Prediction") 
    ) 
    }) 


    data2 <- reactive({ 
    req(input$file2) 
    File1 <- input$file2 
    raw.data <- read.csv(File1$datapath,header=T,na.strings=c("")) 
    raw.data 
    }) 

    preds <- reactive({ 
    raw.data <- data2() 
    testpred <- predict(model()$model, raw.data,type= "prob")[,2] 
    print(testpred) 
    final = cbind(raw.data, testpred) 
    final 
    }) 


    output$table = DT::renderDataTable({ 
    DT::datatable(data(), options = list(pageLength = 15)) 
    }) 

    output$tablePred = DT::renderDataTable({ 
    req(input$file2) 
     DT::datatable(preds(), options = list(pageLength = 15)) 
    }) 

    output$downloadData <- downloadHandler(
    filename = function() { paste('SLA Prediction', '.csv', sep='') }, 
    content = function(file) { 
     write.csv(preds(),file) 
    } 
) 
    return(output) 
}) 


shinyApp(ui, server) 
+0

ありがとうございました。私は上記のコードをうまくいきました。 Shiny Appの結果タブに1つの質問だけが表示されます。ダウンロードする出力を表示する必要があります。これはfinal = cbind(raw.data、testpred)で利用できますが、結果タブではモデルを作成するために渡したデータを表示できます、私を助けることができます私はこれを – user3734568

+0

確かめてください! 利用可能な場合、テストデータと予測が新しいtabPanelに表示されるようになりました。私はまたパッケージshinyskyからbusyIndi​​catorを追加し、shinythemesパッケージでテーマを変更しました。 –

+0

新しいtabPanelが気に入らず、tabPanelの "results"のデータを置き換えたい場合は、それを削除して出力$ tableを次のように置き換えてください: 'output $ table = DT :: renderDataTable({ if DT :: datatable(data()、options = list(pageLength = 15))このメソッドを呼び出すと、次のような結果が得られます。 ) } }) ' –

関連する問題