R/runDetLoadHelper.R

In PAMscapes: Tools for Summarising and Analysing Soundscape Data

#' @title Run Detection Data Loading Helper App
#'
#' @description Runs a Shiny app that allows users to interactively
#'   find the proper parameters to load a detection dataset using
#'   \link{loadDetectionData}. As of 0.14.0 
#'
#' @param data file path to a CSV file containing detection data
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#'
#' @examples
#' if(interactive()) {
#'   detFile <- system.file('extdata/detectionExample.csv', package='PAMscapes')
#'   runDetLoadHelper(detFile)
#' }
#'
#' @importFrom shiny uiOutput renderUI reactive reactiveVal selectizeInput
#' @importFrom shiny tabsetPanel renderTable
#' @importFrom utils head
#'
#' @export
#'
runDetLoadHelper <- function(data=NULL) {
    runDetectionExplorer(data)
    # if(is.null(data)) {
    #     data <- file.choose()
    # }
    # if(is.data.frame(data)) {
    #     DFNAME <- deparse(sys.call()[[2]])
    # } else {
    #     DFNAME <- NULL
    # }
    # tzVals <- c(
    #     'UTC',
    #     paste0('UTC+', 1:12),
    #     paste0('UTC-', 1:12)
    # )
    # # UI Start ####
    # addResourcePath(prefix='scapex-images', system.file('images', package='PAMscapes'))
    # on.exit(removeResourcePath('scapex-images'))
    # buttonHeight <- '250px'
    # ui <- navbarPage(
    #     id='main',
    #     'Detection Explorer',
    #     ## ui buttons ----
    #     tabPanel(
    #         'Home',
    #         fluidRow(column(1), column(10, 'Click on an image to navigate')),
    #         tags$button(id='btn_data_load',
    #                     class='btn action-button',
    #                     tags$img(src='scapex-images/data-loading.png',
    #                              height=buttonHeight)
    #         ),
    #         tags$button(id='btn_boxplot',
    #                     class='btn action-button',
    #                     tags$img(src='scapex-images/boxplot-ex.png',
    #                              height=buttonHeight)
    #         ),
    #         tags$button(id='btn_scene',
    #                     class='btn action-button',
    #                     tags$img(src='scapex-images/scene-ex.png',
    #                              height=buttonHeight)
    #         ),
    #         tags$button(id='btn_freq_scene',
    #                     class='btn action-button',
    #                     tags$img(src='scapex-images/freq-scene-ex.png',
    #                              height=buttonHeight)
    #         ),
    #     ),
    #     ## ui data ----
    #     tabPanel(
    #         'loadDetectionData',
    #         fluidRow(
    #             h4('Code snippet - copy me!'),
    #             verbatimTextOutput('codeSample')
    #         ),
    #         fluidRow(
    #             h4('Data Preview - If this shows a table, load was successful!'),
    #             uiOutput('dataHeader')
    #         ),
    #         tabsetPanel(type='pills',
    #                     tabPanel(
    #                         'Basic Options',
    #                         fluidRow(
    #                             column(6,
    #                                    selectInput('source', label='source', choices=c('makara', 'csv')),
    #                                    selectInput('detectionType', label='detectionType',
    #                                                choices=c('auto', 'presence', 'detection')),
    #                                    textInput('presenceDuration', label='presenceDuration', value='')
    #                             ),
    #                             column(6,
    #                                    selectizeInput('tz', label='tz', choices=tzVals, options=list(create=TRUE)),
    #                                    selectInput('wide', label='wide',
    #                                                choices=list('FALSE'=FALSE, 'TRUE'=TRUE)),
    #                                    selectInput('extraCols', label='extraCols', choices=character(0),
    #                                                multiple=TRUE)
    #                             )
    #                         )
    #                     ),
    #                     tabPanel(
    #                         'columnMap',
    #                         uiOutput('colMap')
    #                     ),
    #                     tabPanel(
    #                         'If wide=TRUE',
    #                         uiOutput('wideBucket')
    #                     ),
    #                     tabPanel(
    #                         'Raw Data',
    #                         uiOutput('rawData')
    #                     )
    #         )
    #     ),
    #     ## ui plots ----
    #     navbarMenu(
    #         'Plot',
    #         tabPanel(
    #             'plotAcousticScene',
    #             h4(em('plotAcousticScene')),
    #             'Acoustic Presence / Acoustic Scene',
    #             plotOutput('plot_scene'),
    #             verbatimTextOutput('code_scene'),
    #             fluidRow(
    #                 column(2, selectInput(
    #                     'scene_by',
    #                     label='by',
    #                     choices=c('none'),
    #                     selected='none'
    #                 )),
    #                 column(2, selectInput(
    #                     'scene_combine',
    #                     label='combineYears',
    #                     choices=c(TRUE, FALSE),
    #                     selected=FALSE
    #                 )),
    #                 column(2, selectInput(
    #                     'scene_usefreq',
    #                     label='Use Frequency',
    #                     choices=c(TRUE, FALSE),
    #                     selected=FALSE
    #                 ))
    #             ),
    #             DTOutput('scene_freqmap')
    #         ),
    #         tabPanel(
    #             'plotDetectionBoxplot',
    #             h4(em('plotDetectionBoxplot')),
    #             'Summarized Detection Boxplot',
    #             plotOutput('plot_boxplot'),
    #             fluidRow(
    #                 column(2, selectInput(
    #                     'box_bin1',
    #                     label='bin1',
    #                     choices=c('hour', 'day', 'week'),
    #                     selected='day'
    #                 )),
    #                 column(2, selectInput(
    #                     'box_bin2',
    #                     label='bin2',
    #                     choices=c('day', 'week', 'month'),
    #                     selected='week'
    #                 )),
    #                 column(3, selectInput(
    #                     'box_group',
    #                     label='group',
    #                     choices='species',
    #                     selected='species'
    #                 )),
    #                 column(3, selectInput(
    #                     'box_facet',
    #                     label='facet',
    #                     choices='none',
    #                     selected='none'
    #                 )),
    #                 column(2, selectInput(
    #                     'box_combine',
    #                     label='combineYears',
    #                     choices=c(TRUE, FALSE),
    #                     selected=FALSE
    #                 ))
    #             ),
    #             'Copy/paste this code to recreate this plot:',
    #             verbatimTextOutput('code_boxplot')
    #         )
    #     )
    # )
    # server <- function(input, output, session) {
    #     if(is.character(data)) {
    #         # df <- read.csv(data, nrows = 10, stringsAsFactors = FALSE)
    #         df <- read.csv(data, stringsAsFactors = FALSE)
    #     } else if(is.data.frame(data)) {
    #         # df <- head(data, 10)
    #         df <- data
    #     }
    #     origNames <- reactiveVal(colnames(df))
    #     funArgs <- reactiveVal(list(x=data))
    #     plotData <- reactiveVal('Loading...')
    #     categoryCols <- reactiveVal(character(0))
    #     freqMap <- reactiveVal(data.frame())
    #     # update plot columns ####
    #     observeEvent(plotData(), {
    #         data <- plotData()
    #         if(is.character(data)) {
    #             categoryCols(character(0))
    #         } else {
    #             notCategory <- c('detectionType', 'detectedFlag')
    #             otherCols <- names(data)[!names(data) %in% notCategory]
    #             newCats <- sapply(data[otherCols], function(x) {
    #                 is.character(x) | is.factor(x) | is.logical(x)
    #             })
    #             categoryCols(otherCols[newCats])
    #             # do species vals and freq map
    #             spVals <- unique(data$species)
    #             oldMap <- freqMap()
    #             newMap <- data.frame(species=spVals, freqMin=NA, freqMax=NA)
    #             if(nrow(oldMap) == 0) {
    #                 freqMap(newMap)
    #             } else {
    #                 oldMap <- bind_rows(
    #                     oldMap,
    #                     newMap[!newMap$species %in% oldMap$species, ]
    #                 )
    #                 freqMap(oldMap)
    #             }
    #         }
    #     })
    #     observeEvent(categoryCols(), {
    #         cats <- categoryCols()
    #         if(length(cats) > 0) {
    #             updateSelectInput(
    #                 session,
    #                 'box_group',
    #                 choices=cats,
    #                 selected=input$box_group
    #             )
    #             updateSelectInput(
    #                 session,
    #                 'box_facet',
    #                 choices=c('none', cats),
    #                 selected=input$box_facet
    #             )
    #             updateSelectInput(
    #                 session,
    #                 'scene_by',
    #                 choices=c('none', cats[cats != 'species']),
    #                 selected=input$scene_by
    #             )
    #         } else {
    #             updateSelectInput(
    #                 session,
    #                 'box_group',
    #                 choices='species',
    #                 selected='species'
    #             )
    #             updateSelectInput(
    #                 session,
    #                 'box_facet',
    #                 choices='none',
    #                 selected='none'
    #             )
    #             updateSelectInput(
    #                 session,
    #                 'scene_by',
    #                 choices='none',
    #                 selected='none'
    #             )
    #         }
    #     })
    #     updateSelectInput(inputId='extraCols', choices=names(df))
    #     # Update args ####
    #     observeEvent(input$source, {
    #         newArg <- funArgs()
    #         newArg$source <- input$source
    #         funArgs(newArg)
    #     })
    #     observeEvent(input$detectionType, {
    #         newArg <- funArgs()
    #         newArg$detectionType <- input$detectionType
    #         funArgs(newArg)
    #     })
    #     observeEvent(input$wide, {
    #         newArg <- funArgs()
    #         newArg$wide <- input$wide == 'TRUE'
    #         funArgs(newArg)
    #     })
    #     observeEvent(input$wideDetVals, {
    #         newArg <- funArgs()
    #         newArg$detectedValues <- input$wideDetVals
    #         funArgs(newArg)
    #     }, ignoreNULL=FALSE)
    #     observeEvent(input$speciesCols, {
    #         newArg <- funArgs()
    #         newArg$speciesCols <- input$speciesCols
    #         funArgs(newArg)
    #     }, ignoreNULL=FALSE)
    #     observeEvent(input$extraCols, {
    #         newArg <- funArgs()
    #         newArg$extraCols <- input$extraCols
    #         funArgs(newArg)
    #     }, ignoreNULL=FALSE)
    #     observeEvent(input$presenceDuration, {
    #         newArg <- funArgs()
    #         newVal <- input$presenceDuration
    #         if(!is.na(suppressWarnings(as.numeric(newVal)))) {
    #             newVal <- as.numeric(newVal)
    #         }
    #         if(is.null(newVal) || length(newVal) == 0 || newVal == '') {
    #             newArg$presenceDuration <- NULL
    #         } else {
    #             newArg$presenceDuration <- newVal
    #         }
    #         funArgs(newArg)
    #     }, ignoreNULL=FALSE)
    #     colListen <- reactive({
    #         list(input$selectUTC, input$selectEnd, input$selectSpecies,
    #              input$selectEffortStart, input$selectEffortEnd)
    #     })
    #     observeEvent(colListen(), {
    #         utc <- input$selectUTC
    #         end <- input$selectEnd
    #         species <- input$selectSpecies
    #         effStart <- input$selectEffortStart
    #         effEnd <- input$selectEffortEnd
    #         colMap <- list(UTC=NA, end=NA, species=NA, effortStart=NA, effortEnd=NA)
    #         if(is.null(utc) || length(utc) == 0 || utc == '') {
    #             colMap$UTC <- NULL
    #         } else {
    #             colMap$UTC <- utc
    #         }
    #         if(is.null(end) || length(end) == 0 || end == '') {
    #             colMap$end <- NULL
    #         } else {
    #             colMap$end <- end
    #         }
    #         if(is.null(species) || length(species) == 0 || species == '') {
    #             colMap$species <- NULL
    #         } else {
    #             colMap$species <- species
    #         }
    #         if(is.null(effStart) || length(effStart) == 0 || effStart == '') {
    #             colMap$effortStart <- NULL
    #         } else {
    #             colMap$effortStart <- effStart
    #         }
    #         if(is.null(effEnd) || length(effEnd) == 0 || effEnd == '') {
    #             colMap$effortEnd <- NULL
    #         } else {
    #             colMap$effortEnd <- effEnd
    #         }
    #         
    #         newArg <- funArgs()
    #         if(length(colMap) == 0) {
    #             newArg$columnMap <- NULL
    #         } else {
    #             newArg$columnMap <- colMap
    #         }
    #         funArgs(newArg)
    #     })
    #     observeEvent(input$tz, {
    #         newArg <- funArgs()
    #         newArg$tz <- utcToOlson(input$tz)
    #         funArgs(newArg)
    #     })
    #     # columnMap page ####
    #     output$colMap <- renderUI({
    #         fluidPage(
    #             fluidRow(
    #                 column(4,
    #                        selectizeInput('selectUTC', '"UTC" column', choices=origNames(),
    #                                       multiple=TRUE, options = list(maxItems=1))
    #                 ),
    #                 column(4,
    #                        selectizeInput('selectEnd', '"end" column', choices=origNames(),
    #                                       multiple=TRUE, options = list(maxItems=1))
    #                 ),
    #                 column(4,
    #                        selectizeInput('selectSpecies', '"species" column', choices=origNames(),
    #                                       multiple=TRUE, options = list(maxItems=1))
    #                 )
    #             ),
    #             fluidRow(
    #                 column(4,
    #                        selectizeInput('selectEffortStart', '"effortStart" column', choices=origNames(),
    #                                       multiple=TRUE, options = list(maxItems=1))
    #                 ),
    #                 column(4,
    #                        selectizeInput('selectEffortEnd', '"effortEnd" column', choices=origNames(),
    #                                       multiple=TRUE, options = list(maxItems=1))
    #                 )
    #             )
    #         )
    #     })
    #     
    #     # Wide page ####
    #     output$wideBucket <- renderUI({
    #         fluidRow(
    #             column(6,
    #                    selectizeInput('speciesCols',
    #                                   label='Species columns',
    #                                   choices=origNames(),
    #                                   selected=NULL,
    #                                   multiple=TRUE)
    #             ),
    #             column(6,
    #                    selectInput('wideDetVals',
    #                                label='Positive Detection',
    #                                choices=character(0),
    #                                multiple=TRUE)
    #             )
    #         )
    #     })
    #     observeEvent(input$speciesCols, {
    #         oldSel <- input$wideDetVals
    #         possVals <- unique(unlist(df[input$speciesCols]))
    #         possVals <- possVals[!is.na(possVals)]
    #         updateSelectInput(inputId = 'wideDetVals',
    #                           choices=possVals,
    #                           selected=oldSel[oldSel %in% possVals])
    #     })
    #     # data page ----
    #     output$codeSample <- renderPrint({
    #         argList <- funArgs()
    #         argText <- argToText(argList, dfName=DFNAME)
    #         argText <- paste0('loadDetectionData(', argText, ')')
    #         cat(argText)
    #     })
    #     observe({
    #         tryLoad <- tryCatch({
    #             do.call(loadDetectionData, funArgs())
    #         },
    #         warning = function(w) {
    #             w
    #         },
    #         error = function(e) {
    #             e
    #         })
    #         noLoad <- FALSE
    #         if(inherits(tryLoad, 'error')) {
    #             noLoad <- TRUE
    #             badReason <- 'Error: '
    #         }
    #         if(inherits(tryLoad, 'warning')) {
    #             noLoad <- TRUE
    #             badReason <- 'Warning: '
    #         }
    #         if(isTRUE(noLoad)) {
    #             badMessage <- paste0(badReason, tryLoad$message)
    #             plotData(badMessage)
    #         } else {
    #             plotData(tryLoad)
    #         }
    #     })
    #     output$dataHeader <- renderUI({
    #         tryLoad <- plotData()
    #         if(is.character(tryLoad)) {
    #             return(renderPrint({
    #                 print('Not able to load data with these settings')
    #                 print(tryLoad)
    #             }))
    #         }
    #         tryLoad$UTC <- format(tryLoad$UTC, format='%Y-%m-%d %H:%M:%S')
    #         tryLoad$end <- format(tryLoad$end, format='%Y-%m-%d %H:%M:%S')
    #         renderTable(head(tryLoad))
    #     })
    #     output$rawData <- renderUI({
    #         renderTable(head(df, 10))
    #     })
    #     # buttons ----
    #     observeEvent(input$btn_data_load, {
    #         updateNavbarPage(session, 'main', 'loadDetectionData')
    #     })
    #     observeEvent(input$btn_boxplot, {
    #         updateNavbarPage(session, 'main', 'plotDetectionBoxplot')
    #     })
    #     observeEvent(input$btn_scene, {
    #         updateSelectInput(session, 'scene_usefreq', selected='FALSE')
    #         updateNavbarPage(session, 'main', 'plotAcousticScene')
    #     })
    #     observeEvent(input$btn_freq_scene, {
    #         updateSelectInput(session, 'scene_usefreq', selected='TRUE')
    #         updateNavbarPage(session, 'main', 'plotAcousticScene')
    #     })
    #     # plots ----
    #     output$plot_scene <- renderPlot({
    #         data <- plotData()
    #         if(is.character(data)) {
    #             plot(x=1, y=1, type='n')
    #             text(x=1, y=1, label='Data not properly loaded\nUse loadDetectionData panel')
    #             return()
    #         }
    #         if(input$scene_by == 'none') {
    #             by <- NULL
    #         } else {
    #             by <- input$scene_by
    #         }
    #         if(input$scene_usefreq == 'FALSE') {
    #             map <- NULL
    #         } else {
    #             spVals <- unique(data$species)
    #             map <- freqMap()
    #             spIn <- map$species %in% spVals
    #             if(anyNA(map$freqMin[spIn]) ||
    #                anyNA(map$freqMax[spIn])) {
    #                 map <- NULL
    #             }
    #         }
    #         combine <- input$scene_combine == 'TRUE'
    #         plotAcousticScene(data, by = by, freqMap=map, combineYears=combine)
    #     })
    #     output$code_scene <- renderPrint({
    #         argList <- list(x=data)
    #         if(input$scene_by != 'none') {
    #             argList$by <- input$scene_by
    #         }
    #         argList$combineYears <- input$scene_combine == 'TRUE'
    #         if(input$scene_usefreq == 'TRUE') {
    #             argList$freqMap <- as.list(freqMap())
    #         }
    #         argText <- argToText(argList, dfName=DFNAME, listName='data.frame')
    #         argText <- paste0('plotAcousticScene(', argText, ')')
    #         cat(argText)
    #     })
    #     output$scene_freqmap <- renderDT({
    #         if(input$scene_usefreq == 'FALSE') {
    #             return(data.frame())
    #         }
    #         spVals <- unique(plotData()$species)
    #         map <- freqMap()
    #         map[map$species %in% spVals, ]
    #         freqMap()
    #     },
    #     server=FALSE,
    #     options=list(dom='t'),
    #     editable=TRUE,
    #     selection=list(target='cell')
    #     )
    #     observeEvent(input$scene_freqmap_cell_edit, {
    #         info <- input$scene_freqmap_cell_edit
    #         oldMap <- freqMap()
    #         val <- suppressWarnings(as.numeric(info$value))
    #         if(info$col != 1 && !is.na(val)) {
    #             oldMap[info$row, info$col] <- val
    #             freqMap(oldMap)
    #         }
    #     })
    #     output$plot_boxplot <- renderPlot({
    #         data <- plotData()
    #         if(is.character(data)) {
    #             plot(x=1, y=1, type='n')
    #             text(x=1, y=1, label='Data not properly loaded\nUse loadDetectionData panel')
    #             return()
    #         }
    #         if(input$box_facet == 'none') {
    #             facet <- NULL
    #         } else {
    #             facet <- input$box_facet
    #         }
    #         group <- input$box_group
    #         combine <- input$box_combine == 'TRUE'
    #         bin <- paste0(input$box_bin1, '/', input$box_bin2)
    #         plotDetectionBoxplot(data, group=group, bin=bin, facet=facet, combineYears=combine)
    #     })
    #     output$code_boxplot <- renderPrint({
    #         argList <- list(x=data)
    #         argList$group <- input$box_group
    #         if(input$box_facet == 'none') {
    #             facet <- NULL
    #         } else {
    #             argList$facet <- input$box_facet
    #         }
    #         argList$bin <- paste0(input$box_bin1, '/', input$box_bin2)
    #         argList$combineYears <- input$box_combine == 'TRUE'
    #         
    #         argText <- argToText(argList, dfName=DFNAME)
    #         argText <- paste0('plotDetectionBoxplot(', argText, ')')
    #         cat(argText)
    #     })
    # }
    # runApp(shinyApp(ui=ui, server=server))
}

# utcToOlson <- function(tz) {
#     if(grepl('UTC\\-', tz)) {
#         tz <- gsub('UTC\\-', 'Etc/GMT+', tz)
#     }
#     if(grepl('UTC\\+', tz)) {
#         tz <- gsub('UTC\\+', 'Etc/GMT-', tz)
#     }
#     tz
# }

# argToText <- function(x, type='c', max=5, dfName='x', listName='list') {
#     for(i in seq_along(x)) {
#         val <- x[[i]]
#         if(is.character(val)) {
#             val <- paste0("'", val, "'")
#         }
#         if(is.data.frame(val)) {
#             val <- dfName
#         }
#         if(!is.list(val) && length(val) > 1) {
#             val <- paste0(val, collapse=', ')
#             val <- paste0(type, '(', val, ')')
#         }
#         if(is.list(val)) {
#             val <- argToText(val, max=1e3)
#             val <- paste0(listName, '(', val, ')')
#         }
#         x[[i]] <- val
#     }
#     x <- paste0(names(x), '=', unlist(x))
#     nArgs <- length(x)
#     if(nArgs > max) {
#         atMax <- seq(from=max, to=nArgs-1, by=max)
#         for(ix  in atMax) {
#             x[ix] <- paste0('\n', x[ix])
#         }
#     }
#     x <- paste0(x, collapse=', ')
#     x
# }