I am relatively new on using R Shiny, I am trying to build Shiny app for predictive modeling. I have R code ready with me and have loaded them in R Shiny.
Please refer to below ui.r and server.r which I have prepared.
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)
})
Model is created using first Input file, my requirement is user should asked to upload 2nd input file (for which they want to predict results) only if model Accuracy which calculated using first input file stored in variable acc should be more than 0.9, I am not able to get solution for this, can anyone help me in this.
Now the second file input depends on the variable acc and shows up only when it is bigger than 0.9. I additionally did some changes, mainly because your code didn't work on my laptop :). Instead of return(NULL) you can use the function req to ensure that the values are available.
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)