I have made an application on R shiny that I share with friends on the same network. I host the application on my remote computer and people connect to it using dedicated ports. I am trying to make a download button that saves a data.frame in an excel file and downloads the excel file in the user's computer. Currently, I am able to make the download button but it only writes the file to a folder in the remote server. I need help with the downloadhandler essentially. Thank you for your time. Here a csc reproducible example
library(shiny)
library(e1071)
library(rminer)
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggvis)
library(corrplot)
library(DT)
library(caret)
ui <- navbarPage(title = "HR Analytics ",
tabPanel("Data Import",
sidebarLayout(sidebarPanel(
fileInput('file1', 'Choose CSV File to upload',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
helpText("Note: Please ensure that the the file is in .csv",
"format and contains headers."),
tags$hr(),
actionButton("do", "Import")
),
mainPanel(h2(helpText("Descriptive Statistics")),
verbatimTextOutput('contents'))
)
),#tabpanel
tabPanel("Predictive Model",
sidebarLayout(sidebarPanel(
uiOutput("model_select"),
actionButton("enter", "Enter")
),
mainPanel(h2(helpText("Model Output")),
verbatimTextOutput('modelOutput'))
)
),#tabpanel
tabPanel("Report",
sidebarLayout(sidebarPanel(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
helpText("Download final list of employess to be retained"),
br(),
uiOutput("modsel"),
helpText("Select Model"),
uiOutput("noselect"),
helpText("Select number pf employess"),
downloadButton('downloadData', 'Download'),
helpText("Download final list of employees to be retained")
),
mainPanel(h2(helpText("Retained Employees")),
dataTableOutput("reportOutput"))
)
)#tabpanel
)
library(shiny)
server <- function(input, output) {
hr = eventReactive(input$do,{
inFile <- input$file1
if (is.null(inFile))
return(NULL)
hr = read.csv(inFile$datapath, header=T, sep=",")
})
output$contents <- renderPrint({
return(summary(hr()))
})
output$model_select<-renderUI({
selectInput("modelselect","Select the model",choices = c("Tree Learning"="rpart","Logistic Regression"="LogitBoost", "Naive Bayes" = "nb"))
})
output$modsel<-renderUI({
selectInput("modelselect2","Select Algo",choices = c("Logistic Regression","Naives Bayes","Tree Learning"),selected = "Logistic_reg")
})
output$noselect<- renderUI({
sliderInput("noselect", "Number of observations:",
min = 0, max = 300, value = 20)})
algo = eventReactive(input$enter,{
return(input$modelselect)
})
output$modelOutput <- renderPrint({
hr_model <- hr() %>% filter(left==0 | last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
hr_model$left <- as.factor(hr_model$left)
train_control<- trainControl(method="cv", number=5, repeats=3)
rpartmodel<- train(left~., data=hr_model, trControl=train_control, method=algo())
# make predictions
predictions<- predict(rpartmodel,hr_model)
hr_model_tree<- cbind(hr_model,predictions)
# summarize results
confusionMatrix<- confusionMatrix(hr_model_tree$predictions,hr_model_tree$left)
confusionMatrix
})
rt <- reactive(
if(input$modelselect2== "Logistic Regression"){
f1<-data()
hr_model1 <- hr() %>% filter(left==0 |last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
hr_model1$left <- as.factor(hr_model1$left)
train_control<- trainControl(method="cv", number=5, repeats=3)
# Keep some data to test again the final model
set.seed(100)
inTraining <- createDataPartition(hr_model1$left, p = .75, list = FALSE)
training <- hr_model1[ inTraining,]
testing <- hr_model1[-inTraining,]
# Estimate the drivers of attrition
logreg = glm(left ~ ., family=binomial(logit), data=training)
# Make predictions on the out-of-sample data
probaToLeave=predict(logreg,newdata=testing,type="response")
# Structure the prediction output in a table
predattrition = data.frame(probaToLeave)
# Add a column to the predattrition dataframe containing the performance
predattrition$performance=testing$last_evaluation
predattrition$priority=predattrition$performance*predattrition$probaToLeave
orderpredattrition=predattrition[order(predattrition$priority,decreasing = TRUE),]
orderpredattrition <- head(orderpredattrition, n=input$noselect)
or<- data.frame(orderpredattrition)
or
}
else if(input$modelselect2== "Naives Bayes"){
f1<-data()
hr_model1 <- hr() %>% filter(left==0 |last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
hr_model1$left <- as.factor(hr_model1$left)
train_control<- trainControl(method="cv", number=5, repeats=3)
# Keep some data to test again the final model
set.seed(100)
inTraining <- createDataPartition(hr_model1$left, p = .75, list = FALSE)
training <- hr_model1[ inTraining,]
testing <- hr_model1[-inTraining,]
# Estimate the drivers of attrition
e1071model2 = naiveBayes(left ~ ., data=training)
# Make predictions on the out-of-sample data
probaToLeave=predict( e1071model2,newdata=testing[,c(-7,-9,-10)],type="raw")
# Structure the prediction output in a table
predattrition = data.frame(probaToLeave)
colnames(predattrition) <- c("c","probaToLeave")
predattrition[1] <- NULL
# Add a column to the predattrition dataframe containing the performance
predattrition$performance=testing$last_evaluation
predattrition$priority=predattrition$performance*predattrition$probaToLeave
orderpredattrition=predattrition[order(predattrition$priority,decreasing = TRUE),]
orderpredattrition <- head(orderpredattrition, n=input$noselect)
or<- data.frame(orderpredattrition)
}
else if(input$modelselect2== "Tree Learning"){
f1<-data()
hr_model1 <- hr() %>% filter(left==0 |last_evaluation >= 0.70 | time_spend_company >= 4 | number_project > 5)
hr_model1$left <- as.factor(hr_model1$left)
train_control<- trainControl(method="cv", number=5, repeats=3)
# Keep some data to test again the final model
set.seed(100)
inTraining <- createDataPartition(hr_model1$left, p = .75, list = FALSE)
training <- hr_model1[ inTraining,]
testing <- hr_model1[-inTraining,]
# Estimate the drivers of attrition
rpartmodel = rpart(left ~ satisfaction_level+last_evaluation+number_project+average_montly_hours+time_spend_company+Work_accident+promotion_last_5years,method = "anova",data=training)
# Make predictions on the out-of-sample data
probaToLeave=predict(rpartmodel,newdata=testing[,c(-7,-9,-10)],type="vector")
# Structure the prediction output in a table
predattrition = data.frame(probaToLeave)*0.5
# Add a column to the predattrition dataframe containing the performance
predattrition$performance=testing$last_evaluation
predattrition$priority=predattrition$performance*predattrition$probaToLeave
orderpredattrition=predattrition[order(predattrition$priority,decreasing = TRUE),]
orderpredattrition <- head(orderpredattrition, n=input$noselect)
or<- data.frame(orderpredattrition)
or
}
)
output$reportOutput = renderDataTable({
rt()
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$modelselect2, '.csv', sep='') },
content = function(file){
write.csv(rt(), file)
}
)
}
shinyApp(ui=ui, server = server)
anyways i gave like to both since as you indicated, this is the best solution in probably majority of the cases.