Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Save Shiny data into dropbox using rdrop2 #179

Open
saradominguez opened this issue Feb 25, 2020 · 0 comments
Open

Save Shiny data into dropbox using rdrop2 #179

saradominguez opened this issue Feb 25, 2020 · 0 comments

Comments

@saradominguez
Copy link

I have a shiny app with an output image built from a logic conditional. What I want now is to save the data into Dropbox. The app run perfectly. However, I could not find the dataframe from the answers saved in my dropbox. Could anyone kindly help me?
I have first save the token for the rdrop2 into the app directory in a file .httr-oauth

library(shiny)
library(shinyBS)
library(shinymanager)
library(rdrop2)
library(shinyjs)
library(ROAuth)

#create a directory (my path for dropbox)
outputDir <- "C:/Users/sarad/Dropbox/responses"

I have created a splash to run the app

#create a splash
inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer;     // catches mouse clicks
window.onscroll = resetTimer;    // catches scrolling
window.onkeypress = resetTimer;  //catches keyboard actions
function logout() {
window.close();  //close the window
}
function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 1200000);  // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"

splash_ui <- function(id) {
  ns <- NS(id)
  div(id = ns("splash_screen"), img(src = "start.png"),
      style = "text-align:center; padding-top:0.5px;")
}

splash_server <- function(input, output, session) {
  hide("splash_screen", anim = TRUE, animType = "fade", time = 3)
}

Also, a credential page to enter user and password:

# data.frame with credentials info
credentials <- data.frame(
  user = c("xxx"),
  password = c("xxx"),
  #comment = c("name of the study"), 
  stringsAsFactors = FALSE
)

And then the app body:

# Define UI for application
ui <- secure_app( head_auth=tags$script(inactivity), 
                 theme=("bootstrap.min.css"),
                 tag_img=tags$img(src='logo.png', width = 100),
                 fluidPage(useShinyjs(), fluidRow(splash_ui("splash_module")),
  # Application title
  titlePanel(
    tags$h1(tags$img(heigh=400, width=400, src='screeningapp.png')),

Inputs that are the date of birth and weight:

#Inputs
wellPanel(div(selectInput(inputId = "site",label=p(tags$img(height=20,width=20,src='location.png'),"Please provide the Site of recruitment", style ="background-color:#ffffff;font-family:Century Gothic;color:#003333;font-size:18px"),choices=list("1"="ic", "2"="mn", "3"="ma", "4"="mw", "5"="ug", "6"="za", "7"="zw")),tags$style(".well {background-color:#ffffff;}")),style="background-color:#ffffff;border-color: #339966"),
wellPanel(div(dateInput(inputId = "dob", label=p(tags$img(height=40,width=40,src='birth.png'),"Date of birth")),style ="background-color:#ffffff;font-family:Century Gothic;color:#003333;font-size:18px"),div(dateInput(inputId = "date", label=p(tags$img(height=30,width=30,src='hospital.png'),"Date of screening")), style="background-color:#ffffff;font-family:Century Gothic;color:#003333;font-size:18px"),style="background-color:#ffffff;border-color: #339966"),
wellPanel(div(numericInput(inputId = "weight", label=p(tags$img(height=26,width=26,src='weight.png'),"Weight (gr)", tags$em("example:3000",style="font-size:12px")),value=3000, min=1000, max=7000),style ="background-color:#ffffff;font-family:Century Gothic;color:#003333;font-size:18px"),
div(numericInput(inputId = "breath",label=p(tags$img(height=26,width=26,src='fastB.png'),"Number of breathes per minute", tags$em("example:60",style="font-size:12px")),value=70, min=0, max=90),style ="background-color:#ffffff;font-family:Century Gothic;color:#003333;font-size:18px"), style="background-color:#ffffff;border-color: #339966"),
wellPanel(div(actionButton("go", icon("fas fa-magic"), label=p("SCREEN"))), div(bsModal("largeModalID", "Results", "go", size="large", uiOutput("my_ui"),span(textOutput("textR"), style="background-color:#ffffff;font-family:Century Gothic;color:#339966;font-size:30px; font-face:bold"))))
))

And the server

# Define server 
server <- function(input, output,session) {
  result_auth <- secure_server(check_credentials = check_credentials(credentials))
  ss<-callModule(splash_server, "splash_module")

#create a logic
  myval<-eventReactive(input$go, {
                     age<-as.numeric(as.Date(input$date,format="%Y/%m/%d") - as.Date(input$dob, format="%Y/%m/%d"))
                     value_age<-ifelse(age>=28 & age<=365, 1, 0)
                     fast_breathing<-ifelse((age>=28 & age<=60) & 
                                              input$breath>=60, 1, 
                                            ifelse((age>=61 & age<=365) & input$breath>=50,1,0))
                     val_inclusion<-ifelse(value_age==1 & input$weight>=2500 & 
                                             fast_breathing==1, 1, 0)

                     result1<-ifelse(val_inclusion==1, "ELIGIBLE", "NON ELIGIBLE")
                     return(result1)

                   })

#create a data.frame with the inputs  
myval2<-eventReactive(input$go, {
resultdata<-data.frame(i_site=input$site,i_date=input$date, i_dob=input$dob,i_breath=input$breath, i_weight=input$weight, i_elegibility=result1)
return(resultdata)
  })

  #output the image
  output$my_ui<-renderUI({
    if(myval()=="ELIGIBLE")
      img(src='eligible.png', height='350px', width="350px")
    else
      if(myval()=="NON ELIGIBLE")
        img(src='noneligible.png', heigh='350px', width="350px")
    })

#save the data
  output$my_ui2<-renderUI({
    saveData <- function(data) {
      data <- t(data)
      # Create a unique file name
      fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
      # Write the data to a temporary file locally
      filePath <- file.path(tempdir(), fileName)
      write.csv(data, filePath, row.names = FALSE, quote = TRUE)
      # Upload the file to Dropbox
      drop_upload(filePath, path = "C:/Users/sarad/Dropbox/responses")
    }
    saveData(resultdata)
  })


}

# Run the application 
shinyApp(ui = ui, server = server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant