tabulate.R

###############################################################################-
#####      TEMPLATE FOR TABULATING QUESTIONNAIRE DATA IN RSTUDIO SHINY    #####-
##### DEVELOPED IN WINDOWS 7; SHINY 0.14.2; RSTUDIO 1.0.136; R 3.3.2      #####-
##### DIEGO ALBUREZ-GUTIERREZ, 2016                                       #####-
##### http://alburez.me                                                   #####-
############################################################################### -

# PREAMBLE ----
# +++++++++++++++++++

library(shiny)
library(stringr)

no.null <- function(y) ifelse(!length(y), NA, y)

# Values for UI selectize 

house_opts <- c("Select one",1:10)
result_opts <- c("Select one", "Completed", "Denied/unavailable", "Postponed")
interv_opts <- c("Select one", "Diego", "Cristina")
no_cuest <- c("Select one", 1:5)
no_visits <- c("Select one", 1:3)

# define directory to save files

path_to <- getwd() 

# UI ----
# +++++++

ui <- bootstrapPage(
  shinyjs::useShinyjs(),
  navbarPage(paste("Questionnaire input"),
             tabPanel("Paradata",
                      actionButton("see_p", "Open saved in spreadsheet"),
                      actionButton("file_p", "Open folder"),
                      actionButton("save_p", "Save", icon("floppy-o"),style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
                      tags$h6(""),
                      textOutput("output_p", container = tags$code),
                      tags$h6(""),
                      tags$h4("Ubicacion"),
                      div(style="display:inline-block",selectInput("household", label = "Household no. ", width ="125px", choices = house_opts, selectize = TRUE, selected = NULL)),
                      div(style="display:inline-block",numericInput("head", label = "Head (line)", width ="100px", value = NULL)),
                      tags$h4("Personas que responden"),
                      div(style="display:inline-block",numericInput("responds1", label = "1st (line)", width ="100px", value = NULL)),
                      div(style="display:inline-block",numericInput("responds2", label = "2nd (line)", width ="100px", value = NULL)),
                      div(style="display:inline-block",numericInput("responds3", label = "3rd (line)", width ="100px", value = NULL)),
                      div(style="display:inline-block",textInput("contact", label = "Mobile phone", width ="150px", value = NULL)),
                      tags$h4("Visitas al hogar y visita final"),
                      div(style="display:inline-block",dateInput("date1", label = "Visit1", width ="100px", format = "dd/mm/yyyy", value = "2016-10-01", max = Sys.Date())),
                      div(style="display:inline-block",dateInput("date2", label = "Visit2", width ="100px", format = "dd/mm/yyyy", value = "2016-10-01", max = Sys.Date())),
                      div(style="display:inline-block",dateInput("date3", label = "Visit3", width ="100px", format = "dd/mm/yyyy", value = "2016-10-01", max = Sys.Date())),
                      div(style="display:inline-block",selectInput("visits", label = "Number of visits", width ="120px", choices = no_visits, selectize = T, selected = NULL)),
                      div(style="display:inline-block",selectInput("result", label = "Outcome", width ="200px", choices = result_opts, selectize = T, selected = NULL)),
                      tags$h4("Total number of questionnaires used"),
                      div(style="display:inline-block",selectInput("q_id", label = "Number (all used)", width ="130px", choices = no_cuest, selectize = TRUE, selected = NULL)),
                      tags$h4("Audio recording durations and interviewers"),
                      div(style="display:inline-block",textInput("h", label = "h", width ="50px", value = NULL)),
                      div(style="display:inline-block",textInput("m", label = "m", width ="50px", value = NULL)),
                      div(style="display:inline-block",textInput("s", label = "s", width ="50px", value = NULL)),
                      div(style="display:inline-block",selectInput("interviewer1", label = "Interviewer 1.", width ="130px", choices = interv_opts, selectize = T, selected = NULL)),
                      div(style="display:inline-block",selectInput("interviewer2", label = "Interviewer 2.", width ="130px", choices = interv_opts, selectize = T, selected = NULL)),
                      tags$h4("Comentarios"),
                      div(style="display:inline-block",textInput("comments", label = "Comments", width ="600px", value = NULL))
             ),
             tabPanel("etc...",
                      tags$h1("Add other fields here...")
             )
      ) 
)

# SERVER ----
# ++++++++++++

server <- function(input, output, clientData, session) {
  
  # Save data ====
  # *************
  
  observeEvent(input$save_p, {
    # string everything together
    p_household <- no.null(input$household)
    p_head <- no.null(input$head)
    p_responds1 <- no.null(input$responds1)
    p_responds2 <- no.null(input$responds2)
    p_responds3 <- no.null(input$responds3)
    p_contact <- no.null(input$contact)
    p_date1 <- no.null(format(input$date1, "%d/%m/%Y"))
    p_date2 <- no.null(format(input$date2, "%d/%m/%Y"))
    p_date3 <- no.null(format(input$date3, "%d/%m/%Y"))
    p_visits <- no.null(input$visits)
    p_result <- no.null(input$result)
    p_q_id <- no.null(input$q_id)
    p_h <- no.null(input$h)
    p_m <- no.null(input$m)
    p_s <- no.null(input$s)
    p_duracion_audio <- paste0(p_h,":",p_m,":",p_s)
    p_h <- p_m <- p_s <- NULL
    p_interviewer1 <- no.null(input$interviewer1)
    p_interviewer2 <- no.null(input$interviewer2)
    p_comments<- no.null(input$comments)
    # String together as data frame
    paradata <- data.frame(do.call(cbind,mget(ls(pattern = "^p_"))), stringsAsFactors = F)
    # delete empty rows and unwanted values
    paradata <- paradata[!(rowSums(is.na(paradata))==NCOL(paradata)),]
    paradata[paradata == "Select one"] <- NA
    paradata[paradata == "01/10/2016"] <- NA
    # export
    write.csv(paradata,paste0(path_to,"paradata",".csv"), row.names=F)
  })
  
  # Output message ====
  # ********************
  
  output_message <- eventReactive(input$save_p, {
    cat("Data for household", input$household, "saved --", as.character(Sys.time()))
  })
  output$output_p <- renderPrint({ output_message()  })
  
  # Open spreadsheet button ====
  # ******************
  
  observeEvent(input$see_p, {
    path.sp <- "paradata.csv"
    path <- paste0(path_to, path.sp)
    shell.exec(paste(path))
  })
  
  # Open folder button ====
  # ************************
  
  observeEvent(input$file_p, {
    shell.exec(paste(path_to))
  })
}

# RUN  APP ----
# +++++++++++++

shinyApp(ui = ui, server = server)