turtleviewer: WA Turtle Data Viewer

#' @import shiny
#' @importFrom magrittr %>%
app_server <- function(input, output, session) {
  # callModule(mod_odk_server, "mod_odk_ui")
  observeEvent(input$browser,{browser()})
  
  # ---------------------------------------------------------------------------#
  # Data preparation
  # ---------------------------------------------------------------------------#
  
  # ---------------------------------------------------------------------------#
  # Load data: packaged for now, dynamic later
  canned_data <- reactive({
    e <- new.env()
    utils::data("turtledata", package = "turtleviewer", envir = e)
    e$turtledata
  })
  
  raw_data <- reactive({
    
    # datafile <- fs::path("inst/app/www/odk/turtledata.rda")
    datafile <- fs::path("inst/odk/turtledata.rda")
    
    # Load canned data    
    e <- new.env()
    utils::data("turtledata", package = "turtleviewer", envir = e)
    turtledata_canned <- e$turtledata
    
    # Return newer of canned or raw (if existing) data
    if (fs::file_exists(datafile)){
      e2 <- new.env()
      load(datafile, envir = e2)
      turtledata_raw <- e2$turtledata
      if (turtledata_raw$downloaded_on > turtledata_canned$downloaded_on) {
        out <- turtledata_raw
      } else {
        out <- turtledata_canned
      }
    } else {
      out <- turtledata_canned
    }
    
    waiter::hide_waiter()
    out
    
  })
  
  # ---------------------------------------------------------------------------#
  # UI components data filter
  # raw_data <- data("turtledata") or inst/odk/turtledata.rda
  # get_data <- raw_data() filtered to area_name == input$areapicker
  get_data <- reactive({
    if (is.null(raw_data())) return(NULL)
    if (is.null(input$areapicker)) return(raw_data())
    if (input$areapicker == "All turtle programs") return(raw_data())
    if (input$areapicker == "Other") {
      my_filter <- . %>% dplyr::filter(is.na(area_name))
    } else {
      my_filter <- . %>% dplyr::filter(area_name == input$areapicker)
    }
    
    withProgress( message = "Fitering turtle data to selected area..." , {
    
      list(
        downloaded_on = raw_data()$downloaded_on,
        tracks = raw_data()$tracks %>% my_filter(),
        tracks_dist = raw_data()$tracks_dist %>% my_filter(),
        tracks_log = raw_data()$tracks_log %>% my_filter(),
        tracks_fan_outlier = raw_data()$tracks_fan_outlier %>% my_filter(),
        dist = raw_data()$dist %>% my_filter(),
        mwi = raw_data()$mwi %>% my_filter(),
        svs = raw_data()$svs %>% my_filter(),
        sve = raw_data()$sve %>% my_filter(),
        sites = raw_data()$sites %>% my_filter(),
        areas = raw_data()$areas
      )
    })
  })
  
  # ---------------------------------------------------------------------------#
  # UI output data filter
  output$data_filter <- renderUI({
    shiny::need(raw_data(), message = "Loading data...")
    select_opts <- c("All turtle programs", raw_data()$areas$area_name, "Other")
    selectInput("areapicker", NULL, select_opts)
  })
  
  # ---------------------------------------------------------------------------#
  # UI components download
  output$download_zip <- downloadHandler(
    filename = function() {
      glue::glue(
        "{raw_data()$downloaded_on} {input$areapicker}",
        " turtle data.zip"
      ) %>%
        stringr::str_replace_all(":", "-")
    },
    content = function(file) {
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      files <- NULL
      
      get_data()$tracks %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "tracks.csv"))
      
      get_data()$tracks_dist %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "tracks_dist.csv"))
      
      get_data()$tracks_log %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "tracks_log.csv"))
      
      get_data()$tracks_fan_outlier %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "tracks_fan.csv"))
      
      get_data()$dist %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "dist.csv"))
      
      get_data()$mwi %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "mwi.csv"))
      
      get_data()$svs %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "site_visit_start.csv"))
      
      get_data()$sve %>%
        drop_list_cols() %>%
        readr::write_csv(fs::path(owd, "site_visit_end.csv"))
      
      get_data()$areas %>%
        geojsonio::geojson_write(file = fs::path(owd, "areas.geojson"))
      
      get_data()$sites %>%
        geojsonio::geojson_write(file = fs::path(owd, "sites.geojson"))
      
      files <- c(
        fs::path(owd, "tracks.csv"),
        fs::path(owd, "tracks_dist.csv"),
        fs::path(owd, "tracks_log.csv"),
        fs::path(owd, "tracks_fan.csv"),
        fs::path(owd, "dist.csv"),
        fs::path(owd, "mwi.csv"),
        fs::path(owd, "site_visit_start.csv"),
        fs::path(owd, "site_visit_end.csv"),
        fs::path(owd, "areas.geojson"),
        fs::path(owd, "sites.geojson")
      )
      
      utils::zip(file, files)
    },
    contentType = "application/zip"
  )
  
  # ---------------------------------------------------------------------------#
  # UI output download
  output$data_download <- renderUI({
    shiny::need(raw_data(), message = "Loading data...")
    dl_on <- raw_data()$downloaded_on %>% lubridate::with_tz("Australia/Perth")
    downloadButton(
      "download_zip", 
      glue::glue("Data as of {dl_on} AWST"), 
      class = "btn btn-primary", 
      title = "Download selected data"
    )
  })
  
  # ---------------------------------------------------------------------------#
  # Data visualisation
  # ---------------------------------------------------------------------------#
  
  # ---------------------------------------------------------------------------#
  # UI components tracks
  # TODO add tracks per day_site_species_type; add tracks_log, tracks fans
  output$tracks_map <- leaflet::renderLeaflet({
    get_data()$tracks %>% 
      wastdr::map_tracks_odkc(cluster = T, sites = get_data()$sites)
  })
  
  # output$tracks_table <- reactable::renderReactable({
  #   get_data()$tracks %>%
  #     sf_as_tbl() %>%
  #     rtbl()
  # })
  
  output$tracks_by_season <-
    reactable::renderReactable({
      get_data()$tracks %>%
        sf_as_tbl() %>%
        wastdr::nesting_type_by_season_age_species(.) %>%
        reactable::reactable(
          groupBy = c("season", "species"),
          columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })
  
  output$tracks_by_season_site <-
    reactable::renderReactable({
      get_data()$tracks %>%
        sf_as_tbl() %>%
        wastdr::nesting_type_by_site_season_age_species(.) %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c("season", "site_name", "species"),
          columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })
  
  output$tracks_by_week_site <-
    reactable::renderReactable({
      get_data()$tracks %>%
        sf_as_tbl() %>%
        dplyr::group_by(
          season, 
          iso_week,
          season_week, 
          site_name, 
          species,
          nest_age,
          nest_type
        ) %>% 
        dplyr::tally() %>% 
        dplyr::ungroup() %>%
        tidyr::spread(nest_type, n, fill = 0) %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c("season", "season_week", "species"),
          columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })
  
  output$tracks_by_day_site <-
    reactable::renderReactable({
      get_data()$tracks %>%
        sf_as_tbl() %>%
        dplyr::group_by(
          season, 
          calendar_date_awst, 
          site_name, 
          species,
          nest_age,
          nest_type
        ) %>% 
        dplyr::tally() %>% 
        dplyr::ungroup() %>%
        tidyr::spread(nest_type, n, fill = 0) %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c(
            "season", 
            "calendar_date_awst", 
            "site_name", 
            "species"
          ),
          columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })  
  
  # ---------------------------------------------------------------------------#
  # UI Tracks tab
  output$tracks_tab <- renderUI({
    tagList(
      leaflet::leafletOutput("tracks_map", height = 500),
      tags$h3("Nesting summaries"),
      tags$h4("Nesting by season and species"),
      reactable::reactableOutput("tracks_by_season"),
      tags$h4("Nesting by season, site, and species"),
      reactable::reactableOutput("tracks_by_season_site"),
      tags$h4("Nesting by week, site, and species"),
      reactable::reactableOutput("tracks_by_week_site"),
      tags$h4("Nesting by day, site, and species"),
      reactable::reactableOutput("tracks_by_day_site")
    )
  })
  
  # ---------------------------------------------------------------------------#
  # UI components fanangle_tab
  # https://jokergoo.github.io/circlize_book/book/
  output$tracks_fans_map <- leaflet::renderLeaflet({
    get_data()$tracks %>% 
      dplyr::filter(fan_angles_measured == "yes") %>%
      wastdr::map_tracks_odkc(cluster = T, sites = get_data()$sites)
  })
  
  output$tracks_fans <-
    reactable::renderReactable({
      get_data()$tracks %>%
        dplyr::filter(fan_angles_measured == "yes") %>% 
        sf_as_tbl() %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c(
            "site_name", 
            "species"
          )
          # columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })  
  
  output$tracks_fan_outlier <-
    reactable::renderReactable({
      get_data()$tracks_fan_outlier %>%
        sf_as_tbl() %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c(
            "site_name", 
            "species"
          )
          # columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })  
  # ---------------------------------------------------------------------------#
  # UI tab fanangle_tab
  output$fanangle_tab <- renderUI({
    tagList(
      leaflet::leafletOutput("tracks_fans_map", height = 500),
      reactable::reactableOutput("tracks_fans"),
      reactable::reactableOutput("tracks_fan_outlier")
    )
  })
  
  # ---------------------------------------------------------------------------#
  # UI components excavation_tab
  
  # ---------------------------------------------------------------------------#
  # UI tab excavation_tab
  output$excavation_tab <- renderUI({
    tagList(
      tags$h3("Nest excavations"),
      tags$p("Coming soon")
    )
  })
  
  # ---------------------------------------------------------------------------#
  # UI components logger_tab
  output$tagged_nests_map <- leaflet::renderLeaflet({
    get_data()$tracks %>% 
      dplyr::filter(logger_found == "yes") %>%
      wastdr::map_tracks_odkc(cluster = T, sites = get_data()$sites)
  })
  
  output$tracks_with_logger <-
    reactable::renderReactable({
      get_data()$tracks %>%
        dplyr::filter(logger_found == "yes") %>% 
        sf_as_tbl() %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c(
            "site_name", 
            "species"
          )
          # columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })  
  
  output$tracks_log <-
    reactable::renderReactable({
      get_data()$tracks_log %>%
        sf_as_tbl() %>%
        reactable::reactable(
          searchable = T, 
          filterable = T,
          groupBy = c(
            "site_name", 
            "species"
          )
          # columns = mkcoldef(unique(get_data()$tracks$nest_type))
        )
    })  
  
  # ---------------------------------------------------------------------------#
  # UI tab logger_tab
  output$logger_tab <- renderUI({
    tagList(
      leaflet::leafletOutput("tagged_nests_map", height = 500),
      reactable::reactableOutput("tracks_with_logger"),
      reactable::reactableOutput("tracks_log")
    )
  })  
  
  # ---------------------------------------------------------------------------#
  # UI components Disturbance and Predation
  # Map of Dist, TODO split into Dist and Pred
  output$dist_map <- leaflet::renderLeaflet({
    get_data()$dist %>% 
      wastdr::filter_disturbance() %>% 
      wastdr::map_dist_odkc(
        tracks = get_data()$tracks_dist %>% wastdr::filter_disturbance(),
        sites = get_data()$sites)
  })
  
  output$nest_dist_table <- reactable::renderReactable({
    # CMD check mufflers
    season <- NULL
    site_name <- NULL
    disturbance_cause <- NULL
    n <- NULL
    calendar_date_awst <- NULL
    
    shiny::need(get_data()$tracks_dist, 
                message = "No nest disturbance recorded here.")
    
    get_data()$tracks_dist %>%
      wastdr::filter_disturbance() %>% 
      # dplyr::group_by(season, site_name, disturbance_cause) %>% 
      # dplyr::tally() %>% 
      # dplyr::ungroup() %>% 
      # dplyr::arrange(-n) %>% 
      sf_as_tbl() %>%
      reactable::reactable(
        searchable = T, 
        filterable = T,
        groupBy = c("season", "site_name", "disturbance_cause"),
        details = function(index) {
          tags$div(
            class="col col-2",
            tags$div(tags$strong("Photo")),
            tags$img(width="200px;", alt="Not available",
                     src=get_data()$tracks_dist[index,]$photo_disturbance)
          )
        }
      )
  })
  
  output$dist_table <- reactable::renderReactable({
    shiny::need(get_data()$dist, message = "No disturbance recorded here.")
    
    get_data()$dist %>%
      wastdr::filter_disturbance() %>% 
      # dplyr::group_by(season, site_name, disturbance_cause) %>% 
      # dplyr::tally() %>% 
      # dplyr::ungroup() %>% 
      # dplyr::arrange(-n) %>% 
      sf_as_tbl() %>%
      reactable::reactable(
        searchable = T, 
        filterable = T,
        groupBy = c("season", "site_name", "disturbance_cause"),
        details = function(index) {
          tags$div(
            class="col col-2",
            tags$div(tags$strong("Photo")),
            tags$img(width="200px;", alt="Not available",
                     src=get_data()$tracks_dist[index,]$photo_disturbance)
          )
        }
      )
  })
  
  output$pred_map <- leaflet::renderLeaflet({
    shiny::need(get_data()$dist, message = "No predation recorded here.")
    
    get_data()$dist %>% 
      wastdr::filter_predation() %>% 
      wastdr::map_dist_odkc(
        tracks = get_data()$tracks_dist %>% wastdr::filter_predation(),
        sites = get_data()$sites)
  })
  
  output$nest_pred_table <- reactable::renderReactable({
    shiny::need(get_data()$tracks_dist, 
                message = "No nest predation recorded here.")
    
    get_data()$tracks_dist %>%
      wastdr::filter_predation() %>% 
      # dplyr::group_by(season, site_name, disturbance_cause) %>% 
      # dplyr::tally() %>% 
      # dplyr::ungroup() %>% 
      # dplyr::arrange(-n) %>% 
      sf_as_tbl() %>%
      reactable::reactable(
        searchable = T, 
        filterable = T,
        groupBy = c("season", "site_name", "disturbance_cause"),
        details = function(index) {
          tags$div(
            class="col col-2",
            tags$div(tags$strong("Photo")),
            tags$img(width="200px;", alt="Not available",
                     src=get_data()$tracks_dist[index,]$photo_disturbance)
          )
        }
      )
  })
  
  output$pred_table <- reactable::renderReactable({
    shiny::need(get_data()$dist, message = "No predation recorded here.")
    
    get_data()$dist %>%
      wastdr::filter_predation() %>% 
      # dplyr::group_by(season, site_name, disturbance_cause) %>% 
      # dplyr::tally() %>% 
      # dplyr::ungroup() %>% 
      # dplyr::arrange(-n) %>% 
      sf_as_tbl() %>%
      reactable::reactable(
        searchable = T, 
        filterable = T,
        groupBy = c("season", "site_name", "disturbance_cause"),
        details = function(index) {
          tags$div(
            class="col col-2",
            tags$div(tags$strong("Photo")),
            tags$img(width="200px;", alt="Not available",
                     src=get_data()$tracks_dist[index,]$photo_disturbance)
          )
        }
      )
  })
  
  # ---------------------------------------------------------------------------#
  # UI output Disturbance and Predation
  # TODO split dist and pred
  output$dist_tab <- renderUI({
    tagList(
      leaflet::leafletOutput("dist_map", height = 500),
      tags$h3("Nest disturbances"),
      reactable::reactableOutput("nest_dist_table"),
      tags$h3("General disturbances"),
      reactable::reactableOutput("dist_table")
    )
  })
  
  output$pred_tab <- renderUI({
    tagList(
      leaflet::leafletOutput("pred_map", height = 500),
      tags$h3("Nest predations"),
      reactable::reactableOutput("nest_pred_table"),
      tags$h3("General signs of predator presence"),
      reactable::reactableOutput("pred_table")
    )
  })
  
  # ---------------------------------------------------------------------------#
  # UI components MWI
  # Map of MWI, TODO split into rescues and strandings, add mwi_dmg
  output$mwi_map_live <- leaflet::renderLeaflet({
    shiny::need(get_data()$mwi, 
                message = "No Marine Wildlife Incidents recorded here.")
    
    get_data()$mwi %>% 
      wastdr::filter_alive() %>% 
      wastdr::map_mwi_odkc(sites = get_data()$sites)
  })
  
  output$mwi_table_live <- reactable::renderReactable({
    shiny::need(get_data()$mwi, 
                message = "No Marine Wildlife Incidents recorded here.")
    
    get_data()$mwi %>%
      wastdr::filter_alive() %>% 
      sf_as_tbl() %>%
      reactable::reactable(
        filterable = T, 
        searchable = T,
        groupBy = c("season", "site_name") #,
        # details = function(index) {
        #   tags$div(
        #     class="row",
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat_2),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat_3),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_carapace_top),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_head_top),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_head_side),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_head_front)
        #   )
        # }
      )
  })
  
  output$mwi_map_dead <- leaflet::renderLeaflet({
    shiny::need(get_data()$mwi, 
                message = "No Marine Wildlife Incidents recorded here.")
    
    get_data()$mwi %>% 
      wastdr::filter_dead() %>% 
      wastdr::map_mwi_odkc(sites = get_data()$sites)
  })
  
  output$mwi_table_dead <- reactable::renderReactable({
    shiny::need(get_data()$mwi, 
                message = "No Marine Wildlife Incidents recorded here.")
    
    get_data()$mwi %>%
      wastdr::filter_dead() %>% 
      sf_as_tbl() %>%
      reactable::reactable(
        filterable = T, 
        searchable = T,
        groupBy = c("season", "site_name") #,
        # details = function(index) {
        #   tags$div(
        #     class="row",
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat_2),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat_3),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_carapace_top),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_head_top),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_head_side),
        #     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_head_front)
        #   )
        # }
      )
  })
  
  # ---------------------------------------------------------------------------#
  # UI output MWI
  output$mwi_tab_live <- renderUI({
    tagList(
      leaflet::leafletOutput("mwi_map_live", height = 500),
      tags$h3("Live rescues"),
      reactable::reactableOutput("mwi_table_live")
    )
  })
  
  output$mwi_tab_dead <- renderUI({
    tagList(
      leaflet::leafletOutput("mwi_map_dead", height = 500),
      tags$h3("Strandings"),
      reactable::reactableOutput("mwi_table_dead")
    )
  })
  
  # ---------------------------------------------------------------------------#
  # UI components Surveys, SVS, SVE
  # Map survey start/end points relative to TSC sites
  output$surveys_map <- leaflet::renderLeaflet({
    wastdr::map_sv_odkc(get_data()$svs, get_data()$sve, sites=get_data()$sites)
  })
  # List survey start/end per day, match by site and calendar date
  output$surveys_table <- reactable::renderReactable({
    
    svs_tally <- get_data()$svs %>% 
      sf_as_tbl() %>%
      dplyr::group_by(season, calendar_date_awst, site_name) %>% 
      dplyr::tally() %>% 
      dplyr::rename(no_start_surveys=n) %>% 
      dplyr::ungroup()
    
    sve_tally <- get_data()$sve %>% 
      sf_as_tbl() %>%
      dplyr::group_by(season, calendar_date_awst, site_name) %>% 
      dplyr::tally() %>% 
      dplyr::rename(no_end_surveys=n) %>% 
      dplyr::ungroup()
    
    grp <- c("season", "calendar_date_awst", "site_name")
    
    svs_tally %>% 
      dplyr::full_join(sve_tally, by = grp) %>% 
      reactable::reactable(filterable = T, groupBy = grp)
  })
  
  
  # ---------------------------------------------------------------------------#
  # UI output Surveys, SVS, SVE
  output$survey_tab <- renderUI({
    tagList(
      leaflet::leafletOutput("surveys_map", height = 500),
      tags$h3("Summary of start and end points"),
      tags$p("Every surveyed day should have one start and one end point per site."),
      tags$p("Multiple start points per site indicate need for QA later in TSC."),
      reactable::reactableOutput("surveys_table")
    )
  })
  
  # ---------------------------------------------------------------------------#
  # UI output about
  output$about_tab <- renderUI({
    tagList(
      includeMarkdown(system.file("app/www/about.md", package = "turtleviewer"))
    )
  })
  
}