ohirepos: Create OHI tailored repositories

# packages ----

# refresh fitz.nceas.ucsb.edu after `sudo R` to gain write permissions on R library path:
#   remove.packages(c('leaflet','ohicore','htmlwidgets','aster','sunburstR'))
#   update.packages(ask=F)
#   # then run up to and including `install_packages(pkgs_df)` below

if (!'devtools'  %in% installed.packages()[,1]) install.packages('devtools')
if (!'tidyverse' %in% installed.packages()[,1]) install.packages('tidyverse')
# TODO: check that all packages below are actually needed, including specific tidyverse packages
library(devtools , quietly=T)
library(tidyverse, quietly=T)

pkgs_df = tibble::tribble(
  ~package   ,     ~location,                                                    ~install_args, ~version_min,
  'dplyr',              'CRAN',                                                               '',           '',
  'tidyr',              'CRAN',                                                               '',           '',
  'readr',              'CRAN',                                                               '',           '',
  'stringr',            'CRAN',                                                               '',           '',
  'lubridate',          'CRAN',                                                               '',           '',
  'rgdal',              'CRAN',                                                               '',           '',
  'shiny',              'CRAN',                                                               '',           '',
  'shinydashboard',     'CRAN',                                                               '',           '',
  'htmltools',          'CRAN',                                                               '',           '',
  'markdown',           'CRAN',                                                               '',           '',
  'geojsonio',          'CRAN',                                                               '',           '',
  'jsonlite',           'CRAN',                                                               '',           '',
  'yaml',               'CRAN',                                                               '',           '',
  'DT',                 'CRAN',                                                               '',           '',
  'leaflet',           'Github',                                    list(repo='rstudio/leaflet'),           '',
  'explodingboxplotR', 'Github',                  list(repo='timelyportfolio/explodingboxplotR'),           '',
  'ohicore',           'Github',                    list(repo='ohi-science/ohicore' , ref='dev'),           '',
  'htmlwidgets',       'Github',       list(repo='ramnathv/htmlwidgets', ref=github_pull('237')),           '',
  'ohiaster',          'Github',   list(repo='ohi-science/ohi-aster' , subdir='asterHTMLwidget'),           '',
  'sunburstR',         'Github',                          list(repo='timelyportfolio/sunburstR'),           '')

install_packages = function(pkgs){
  for (i in 1:nrow(pkgs)){ # i = 11
    p = pkgs$package[i]
    if (!p %in% installed.packages()[,1]){
      if (pkgs$location[i] == 'CRAN'){
        install.packages(p)
      } else if (pkgs$location[i] == 'Github'){
        do.call(install_github, pkgs$install_args[[i]])
      } else {
        stop(sprintf('Needed package "%s" not installed, and location "%s" not understood', p, pkgs$location[i]))
      }
    }
  }
}
install_packages(pkgs_df)

for (p in pkgs_df$package){
  library(p, character.only=T, quietly=T)
}

# DEBUG explodingboxplotR
library(shiny)
library(explodingboxplotR)
data(iris)

now_s = function(){
  format(now(), format='%H:%M:%S')
}

init = function(){
  # load configuration
  if (!file.exists('app.yml')) stop('Missing required app.yml, which is generated by deploy_app() function in github.com/ohi-science/ohirepos R package')
  y <<- yaml.load_file('app.yml')
  y_vars = c(
    'gh_repo','study_area','scenario_dirs',
    'gh_owner','app_url','gh_branch_data','gh_branch_app','app_url',
    'projection','map_shrink_pct','debug',
    'ohirepos_commit','last_updated')
  y_missing = setdiff(y_vars, names(y))
  if (length(y_missing) > 0) stop(paste0('Missing variables in app.yml: ', paste(y_missing, collapse=', ')))
  y$gh_slug    <<- sprintf('%s/%s', y$gh_owner, y$gh_repo)
  y$gh_url     <<- sprintf('https://github.com/%s.git', y$gh_slug)
  dir_data     <<- sprintf('%s_%s', y$gh_repo, y$gh_branch_data)
  scenario     <<- y$scenario_dirs[1]
  dir_scenario <<- file.path(dir_data, scenario)
}
init()

load_scenario = function(scenario, env=.GlobalEnv){
  # load new scenario data
  scenario     <<- scenario
  dir_scenario <<- file.path(dir_data, scenario)
  rdata        <<- sprintf('%s_%s.Rdata', y$gh_repo, scenario)
  load(rdata, envir=env)
  init()
}

#options(shiny.reactlog=TRUE)
#options(warn = 0) # warnings: into errors (2) or print as occur (1), store and print (0) or ignore (-1)
#cat(file=stderr(), input$map1_bounds)
#y$debug = F # toggles ui_msg output
#options(shiny.error=traceback)

check_dir_data = function(){
  # check for data branch folder
  dir_data  = sprintf('%s_%s', y$gh_repo, y$gh_branch_data)
  if (!file.exists(dir_data)){

    # git clone data branch
    system(sprintf(
      'git clone --quiet --branch %s %s %s', y$gh_branch_data, y$gh_url, dir_data))
  }
}

create_scenario_rdata = function(scenario, rdata){

  # check for data branch folder
  check_dir_data()

  # check dir_scenario subfolder exists
  dir_scenario = file.path(dir_data, scenario)
  if (!dir.exists(dir_scenario)) stop(sprintf('Although app.yml folder "%s" exists, \nit does not contain subfolder "%s" as specified by the scenario in app.yml. \nRecommend deleting local data folder and rerun Shiny app to clone original, or update app.yml to have correct scenario.', dir_data, y$scenario_dirs[1]))

  # get selectable layers ----

  # read configuration
  if (!file.exists(file.path(dir_scenario, 'conf/config.R'))) stop(sprintf('Missing file conf/config.R in branch/scenario "%s"', dir_scenario))
  config = new.env()
  source(file.path(dir_scenario, 'conf/config.R'), config)
  dims = data_frame(
    dimension   = names(config$dimension_descriptions),
    description = config$dimension_descriptions)

  # read goals and layers
  files = list(
    layers            = 'layers.csv',
    scores            = 'scores.csv',
    goals             = 'conf/goals.csv',
    pressures_matrix  = 'conf/pressures_matrix.csv',
    resilience_matrix = 'conf/resilience_matrix.csv')
  for (i in 1:length(files)){ # i=1
    path = file.path(dir_scenario, files[[i]])
    if (!file.exists(path)) stop(sprintf('Missing file "%s" in branch/scenario "%s"', files[[i]], dir_scenario))
    assign(names(files)[i], read_csv(path))
  }

  # get spatial data path from config
  if (!'geojson' %in% names(config)) stop(sprintf('Missing geojson path variable in %s/conf/config.R', dir_scenario))
  geojson = normalizePath(file.path(dir_scenario, config$geojson))

  # read spatial (can simplify with R package rmapshaper)
  if (!file.exists(geojson)) stop(sprintf('GeoJSON file specified in %s/conf/config.R not found: %s', dir_scenario, geojson))
  cat(file=stderr(), 'read rgns from geojson\n')
  rgns = geojsonio::geojson_read(geojson, what="sp")
  if ('rgn_nam' %in% names(rgns@data) & !'rgn_name' %in% names(rgns@data)) rgns@data = rgns@data %>% mutate(rgn_name = rgn_nam)
  # TODO: check for rgn_area_km2 or remove

  # get countries for Mollweide projection
  if ('projection' %in% names(y) && y$projection == 'Mollweide'){

    # [leaflet/proj4Leaflet.R#L36-L55 · rstudio/leaflet](https://github.com/rstudio/leaflet/blob/1bc41eebd5220735a309c5b4bcfae6784cc9026d/inst/examples/proj4Leaflet.R#L36-L55)
    # addProviderTiles('Stamen.TonerLite') does not work, so use country polygons
    # countries: would use https://github.com/datasets/geo-countries/blob/master/data/countries.geojson, except 23 MB
    cat(file=stderr(), 'read countries from github.com/datasets/geo-boundaries-world-110m\n')
    countries = geojsonio::geojson_read(
      'https://github.com/datasets/geo-boundaries-world-110m/raw/master/countries.geojson', what='sp')
    cat(file=stderr(), 'read countries finished!\n')
  }

  # NOTE: skipping other spatial fields 'saup_id','fao_id'

  goals_colors = colorRampPalette(RColorBrewer::brewer.pal(10, 'Spectral'), space='Lab')(nrow(goals))
  goals = goals %>%
    arrange(order_color) %>%
    mutate(color = goals_colors)

  # prep output score data ----
  output_goals = c(
    '0 Index'='Index',
    setNames(
      goals$goal,
      sprintf('%g %s (%s)', goals$order_hierarchy, goals$name, goals$goal)))

  # prep input layer data ----

  # filter to layers having rgn_id and numeric values
  layers = layers %>%
    filter(!is.na(fld_val_num)) %>%     # TODO: fix to use fld_val_chr for layers (n=5, ICO spatial): ico_spp_extinction_status, ico_spp_popn_trend, rgn_georegion_labels, rgn_global, rgn_labels
    filter(!is.na(fld_id_num)) %>%      # TODO: fix to use fld_id_chr=='cntry_key'(n=24, LE MAR TR) } or fld_id_chr=='fao_saup_id'(n=1, FIS)
    filter(fld_id_num == 'rgn_id') %>%  # TODO: fix to use other fld_id_num. so far only layers (n=2, FS): fis_b_bmsy, fis_proparea_saup2rgn
    arrange(layer)

  # get layers by target goal
  layers_by_target = layers %>%
    select(layer, targets) %>%
    separate(targets, c('target1','target2','target3'), ' ', fill='right') %>%
    gather(target_num, target, target1:target3) %>%
    select(layer, target) %>%
    filter(!is.na(target)) %>%
    left_join(layers, by='layer')

  # get available targets
  layer_targets = layers_by_target %>%
    distinct(target) %>%
    select(target) %>%
    left_join(
      bind_rows(
        goals %>%
          select(target = goal, order_hierarchy, name),
        data.frame(
          target = c('pressures','resilience','spatial'),
          order_hierarchy = c(100, 101, 102),
          name = c('pressures','resilience','spatial'))),
      by='target') %>%
    arrange(order_hierarchy, target) %>%
    select(target, order_hierarchy, name) %>%
    mutate(target_label = sprintf('%g %s (%s)', order_hierarchy, name, target))

  # paste data together for later selecting appropriate category and year values
  if (exists('d_lyrs')) rm(d_lyrs)
  for (i in 1:nrow(layers)){ # i=74
    # layers[i,] %>% select(-description, -fld_id_chr, -fld_val_chr)

    # read in data layer
    d = read_csv(file.path(dir_scenario, 'layers', layers$filename[i]))

    # convert to lower names
    names(d) = tolower(names(d))

    # rename fld_id_num, fld_val_num
    d = rename_(d, 'fld_id_num' = layers$fld_id_num[i], 'fld_val_num' = layers$fld_val_num[i])

    # rename fld_category
    if(!is.na(layers$fld_category[i])){
      d = rename_(d, 'fld_category' = layers$fld_category[i])
      d$fld_category = as.character(d$fld_category)
    } else {
      d$fld_category = NA
    }

    # rename fld_year
    if(!is.na(layers$fld_year[i])){
      d = rename_(d, 'fld_year' = layers$fld_year[i])
    } else {
      d$fld_year = NA
    }

    # set layer name
    d = d %>%
      mutate(layer = layers$layer[i]) %>%
      select(layer, fld_category, fld_year, fld_id_num, fld_val_num) %>%
      arrange(layer, fld_category, fld_year, fld_id_num)

    # bind rows
    if (exists('d_lyrs')){
      d_lyrs = bind_rows(d_lyrs, d)
    } else {
      d_lyrs = d
    }
  }

  # elements for sunburstR ----

  # set colors for layers (pressures, resilience, status)
  layer_colors = RColorBrewer::brewer.pal(5,'Pastel1') %>%
    .[c(1,3,2)] %>%
    setNames(c('pressure','resilience','status'))

  # goals, subgoals
  subgoals = goals %>% filter(!is.na(parent)) %>% .$goal
  nodes = goals %>%
    mutate(
      id         = goal,
      category   = ifelse(is.na(parent), 'goal', 'subgoal'),
      path       = ifelse(is.na(parent), goal, sprintf('%s-%s', parent, goal))) %>%
    select(id, name, category, path, color, order=order_color, description)
  # add goal-goal element to balance goal-subgoal
  nodes = nodes %>%
    bind_rows(
      nodes %>%
        filter(!id %in% subgoals) %>%
        mutate(
          path = sprintf('%s-%s', id, id)))
  # NOTE: nodes$id repeats!

  # layers
  targets_path = nodes %>%
    filter(str_detect(path, '-')) %>%
    select(target=id, parent=path)
  nodes = nodes %>%
    bind_rows(
      # layers for status
      layers_by_target %>%
        filter(target %in% goals$goal) %>%
        left_join(
          targets_path, by='target') %>%
        mutate(
          id       = sprintf('s_%s', layer),
          category = 'status',
          path     = sprintf('%s-s_%s', parent, layer),
          order    = 100,
          color    = layer_colors[['status']]) %>%
        select(id, name, category, path, color, order, color, description),
      # layers for pressures
      pressures_matrix %>%
        gather(layer, value, -goal, -element, -element_name) %>%
        filter(!is.na(value)) %>%
        select(target=goal, layer) %>%
        left_join(
          targets_path, by='target') %>%
        # TODO: add individual elements vs for now getting distinct
        distinct() %>%
        left_join(
          layers, by='layer') %>%
        mutate(
          id    = sprintf('p_%s', layer),
          category = 'pressure',
          path     = sprintf('%s-p_%s', parent, layer),
          order    = 200,
          color    = layer_colors[['pressure']]) %>%
        select(id, name, category, path, color, order, color, description),
      # layers for resilience
      resilience_matrix %>%
        gather(layer, value, -goal, -element) %>%
        filter(!is.na(value)) %>%
        select(target=goal, layer) %>%
        left_join(
          targets_path, by='target') %>%
        # TODO: add individual elements vs for now getting distinct
        distinct() %>%
        left_join(
          layers, by='layer') %>%
        mutate(
          id    = sprintf('r_%s', layer),
          category = 'resilience',
          path     = sprintf('%s-r_%s', parent, layer),
          order    = 300,
          color    = layer_colors[['resilience']]) %>%
        select(id, name, category, path, color, order, color, description))

  # filter paths to terminal paths
  paths = nodes
  for (pth in paths$path){ # pth = paths$path[29]
    if (
      sum(str_detect(paths$path, sprintf('%s-.*', pth))) > 0 |
      # remove goal nodes without layers, including goal-goal having subgoals and no goal-goal-layer such as LE,FP have
      str_count(pth, '-') < 2){
      paths = filter(paths, path != pth)
    }
  }

  # set layer weight based on matching goals weight based on number of layers
  paths2 = paths %>%
    mutate(
      path1 = str_replace(path, '(.+)-(.+)-(.+)','\\1'),
      path2 = str_replace(path, '(.+)-(.+)-(.+)','\\2')) %>%
    left_join(
      goals %>%
        select(goal, path2_weight=weight),
      by=c('path2'='goal')) %>%
    left_join(
      goals %>%
        select(goal, path1_weight=weight),
      by=c('path1'='goal'))
  goals_with_subgoals = goals %>% filter(goal %in% c(goals$parent)) %>% .$goal
  path1_with_goalgoallayer = filter(paths2, path2 %in% goals_with_subgoals) %>% .$path1
  paths = bind_rows(
    # goal-goal-layers or goal-subgoal-layers
    paths2 %>%
      filter(!path1 %in% path1_with_goalgoallayer) %>%
      group_by(path2, path2_weight) %>%
      mutate(
        layer_weight = path2_weight / n()) %>%
      ungroup(),
    # goal-subgoal-layers with goal-goal-layer, eg: FP-FP-s_fp_wildcaught_weight, LE-LE-s_le_sector_weight
    paths2 %>%
      filter(path1 %in% path1_with_goalgoallayer) %>%
      group_by(path1, path1_weight) %>%
      mutate(
        layers_weight = path1_weight / n()) %>%
      ungroup() %>%
      group_by(path2, path2_weight) %>%
      mutate(
        layer_weight = ifelse(
          path2 %in% path1_with_goalgoallayer,
          layers_weight,
          (path2_weight - layers_weight/2) / n())) %>%
      ungroup())

  cols = list(
    range  = c(
      unname(layer_colors),
      distinct(nodes, id, color) %>% .$color), # plotCol(clr)
    domain = c(
      names(layer_colors),
      distinct(nodes, id, color) %>% .$id))

  id_order = nodes %>%
    distinct(id, order) %>%
    bind_rows(
      data_frame(
        id = names(layer_colors),
        order = (-1*length(layer_colors)):-1)) %>%
    arrange(order, id) %>%
    mutate(
      d = row_number(),
      s = sprintf('%s:%d', id, d))

  sort_fxn = paste(
    "
    function(a,b){
    abb = {", paste(id_order$s, collapse=',\n    '), "  }
    return abb[a.name] - abb[b.name];
    }
    ",sep="\n")

  # save to rdata
  save(list = ls(all.names=T), file=rdata, envir=environment())
}

gh_write_remote = function(gh_slug, gh_branch, txt=sprintf('%s_remote_sha.txt', gh_branch)){
  if (is.null(y$gh_data_commit)){
    remote     = devtools:::github_remote(gh_slug, ref=gh_branch)
    remote_sha = devtools:::remote_sha(remote)
    write(remote_sha, txt)
  } else {
    remote_sha = y$gh_data_commit
    write(remote_sha, txt)
  }
  return(remote_sha)
}

check_dir_data()
remote_sha_txt = sprintf('%s_remote_sha.txt', dir_data)
remote_sha = gh_write_remote(y$gh_slug, y$gh_branch_data, remote_sha_txt)
local_sha  = devtools:::git_sha1(path=dir_data, n=nchar(remote_sha))

# check if github remote differs from local
if (devtools:::different_sha(remote_sha, local_sha)){

  # git fetch & overwrite
  if (is.null(y$gh_data_commit)){
    system(sprintf('cd %s; git fetch; git reset --hard origin/%s', dir_data, y$gh_branch_data))
  } else {
    system(sprintf('cd %s; git fetch; git reset --hard %s', dir_data, y$gh_data_commit))
  }

  # update local git commit sha
  local_sha <<- devtools:::git_sha1(path=dir_data, n=nchar(remote_sha))

  # wipe [scenario].Rdata files
  for (scenario in sort(y$scenario_dirs)){
    unlink(sprintf('%s_%s.Rdata', y$gh_repo, scenario))
  }
}

for (scenario in sort(y$scenario_dirs)){
  rdata = sprintf('%s_%s.Rdata', y$gh_repo, scenario)
  if (!file.exists(rdata)){
    # create [scenario].Rdata files
    create_scenario_rdata(scenario, rdata)
  }
}

load_scenario(y$scenario_dirs[1])