library(conflicted)
library(shiny)
library(bslib)
library(shinyjs)
library(tidyverse)
library(jsonlite)
library(stringr)
library(glue)
library(hms)
library(fs)
library(readxl)
library(janitor)
library(knitr)
library(DT)
library(sp)
library(sf)
library(viridis)
library(leaflet)
library(leafem)
library(htmltools)
library(zoo)

conflicts_prefer(
  bslib::page,
  shinyjs::runExample,
  shinyjs::removeClass,
  dplyr::filter,
  dplyr::lag,
  lubridate::show,
  jsonlite::flatten,
  jsonlite::validate,
  hms::hms,
  janitor::chisq.test,
  janitor::fisher.test,
  DT::dataTableOutput,
  DT::renderDataTable,
  zoo::as.Date,
  zoo::as.Date.numeric
)

# 50 MB upload limit
# Also update nginx server { client_max_body_size 50M; }
options(
  "width" = 240,
  shiny.maxRequestSize = 250 * 1024^2
)

# GLOBAL REFERENCE DATA
ref_species_codes <- read_csv(
  "references/SeaLog-Species_CodeList.csv",
  col_types = "ccc",
  col_names = c(
    "common_name",
    "code",
    "scientific_name"
  ),
  skip = 1
) %>%
  select(code, common_name, scientific_name)

nppsd_reference_data <- read_csv(
  "references/nppsd_reference_table_data.csv",
  col_types = "cic"
)

MIN_COUNT <- 1
MAX_COUNT <- 250

ref_behavior <- nppsd_reference_data %>%
  filter(reference_table == "behavior") %>%
  transmute(
    behavior = code,
    in_ref_table = TRUE
  )

ref_weather <- nppsd_reference_data %>%
  filter(reference_table == "weather") %>%
  transmute(
    weather = code,
    in_ref_table = TRUE
  )

MAX_BACKUP_FILES <- 5

unique_str_agg <- function(x) {
  paste(unique(x[!is.na(x)]), collapse = ",")
}

# summary() on a data frame errors under vctrs >= 0.7.3 when a column is <hms>:
# summary.data.frame builds a <summaryDefault> that as.character.hms can no
# longer cast to character. Coerce hms columns to numeric seconds first so the
# overview still renders (e.g. GPSTime shows as seconds since midnight).
summary_no_hms <- function(df) {
  summary(df |> mutate(across(where(\(col) inherits(col, "hms")), as.numeric)))
}

# Make the reprocessing pipeline's silent drops visible. The generate_*()
# steps use inner_join()s (and a points > 1 filter) that quietly discard
# transects/observations whose keys don't match; this reports, to stderr, any
# `keys` combinations present in `before` but missing from `after`. sf geometry
# is dropped before comparing so it works on track lines/centroids too.
log_dropped_keys <- function(r_file, step, before, after, keys) {
  key_set <- function(d) {
    if (inherits(d, "sf")) {
      d <- st_drop_geometry(d)
    }
    distinct(d, across(all_of(keys)))
  }
  before_keys <- key_set(before)
  after_keys <- key_set(after)
  dropped <- anti_join(before_keys, after_keys, by = keys)
  console_log(
    r_file,
    glue(
      "{step}: kept {nrow(after_keys)}/{nrow(before_keys)} ",
      "{paste(keys, collapse = '+')}; dropped {nrow(dropped)}"
    )
  )
  if (nrow(dropped) > 0) {
    dropped_str <- dropped |>
      unite("dropped_key", all_of(keys), sep = "/") |>
      pull(dropped_key) |>
      paste(collapse = ", ")
    console_log(r_file, glue("{step}: dropped {dropped_str}"))
  }
}

Modes <- function(x) {
  ux <- unique(x)
  tab <- tabulate(match(x, ux))
  ux[tab == max(tab)]
}

ui_sort_options <- function(all_column_names, sort_column_names) {
  sort_columns <- list()
  for (i in 1:length(sort_column_names)) {
    name <- sort_column_names[i]
    for (j in 1:length(all_column_names)) {
      if (name == all_column_names[j]) {
        sort_columns[[length(sort_columns) + 1]] <- list(j - 1, "asc")
      }
    }
  }

  sort_columns
}

ui_column_vector <- function(all_column_names, target_column_names) {
  target_columns <- c()
  for (i in 1:length(all_column_names)) {
    name <- all_column_names[i]
    if (any(name %in% target_column_names)) {
      target_columns <- c(target_columns, i - 1)
    }
  }

  target_columns
}

sfc_as_cols <- function(x, names = c("x", "y")) {
  stopifnot(inherits(x, "sf") && inherits(sf::st_geometry(x), "sfc_POINT"))
  ret <- sf::st_coordinates(x)
  ret <- tibble::as_tibble(ret)
  stopifnot(length(names) == ncol(ret))
  x <- x[, !names(x) %in% names]
  ret <- stats::setNames(ret, names)
  dplyr::bind_cols(x, ret)
}

console_log <- function(r_file, message) {
  cat(
    file = stderr(),
    glue("{r_file}: {message}"),
    "\n"
  )
}

# vim: set ft=r fenc=utf-8 tw=80 ts=2 sw=2 sts=2:
