Eingabe der zweiten Datei in R Shiny nur, wenn die Ergebnisse der ersten Eingabedatei die Anforderung erfüllen

Question

Ich bin relativ neu in der Verwendung von R Shiny, ich versuche eine Shiny-App für die prädiktive Modellierung zu erstellen. Ich habe R Code fertig mit mir und habe sie in R Shiny geladen.

Bitte siehe unten ui.r und server.r, die ich vorbereitet habe.

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

Modell wird unter Verwendung eines ersten Eingabedatei erstellt, meine Anforderung Benutzer sollten 2. Eingabedatei laden gefragt (für die sie Ergebnisse vorhersagen wollen) nur dann, wenn Modellgenauigkeit, die in variable acc gespeichert unter Verwendung eines ersten Eingabedatei berechnet sollte mehr als 0.9, kann ich keine Lösung dafür bekommen, kann mir jemand dabei helfen.

Answer 1

Jetzt hängt der zweite Dateieingang von der Variablen acc ab und wird nur angezeigt, wenn er größer als 0,9 ist. Ich habe zusätzlich einige Änderungen vorgenommen, hauptsächlich weil dein Code auf meinem Laptop nicht funktioniert hat :). Anstelle von return(NULL) können Sie mit der Funktion req sicherstellen, dass die Werte verfügbar sind.

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)