inst/shiny_app/global.R

# see launchApp(), makes global variables: conf, layers, scores, dir_spatial, dir_scenario

# load_all('~/Code/ohicore'); load_all('~/Code/ohigui'); launchApp()
require(shiny); require(RJSONIO); require(rCharts); require(RColorBrewer); require(ohicore); require(ohigui)
options(stringsAsFactors = F)
options(error=NULL)

# Data: select score ----
sel_score_target_choices = c('0 Index'='Index', 
                             setNames(conf$goals$goal, 
                                      sprintf('%g %s (%s)', conf$goals$order_hierarchy, conf$goals$name, conf$goals$goal))); # print(names(varGoals))
sel_score_dimension_choices = as.vector(unique(scores$dimension))

# Data: select layer ----

# get unique layers. organized by target (index, goal), which allows for repeat of layer across multiple targets
layer_targets = data.frame(target=character(0), layer=character(0))
for (i in 1:length(layers$targets)){ # i=1
  targets = layers$targets[[i]]
  layer   = names(layers$targets[i])
  layer_targets = rbind(layer_targets, 
                    data.frame(target = targets,
                               layer = rep(layer, length(targets))))
}
layer_targets = merge(layer_targets,
                  rbind(rename(conf$goals[,c('goal','name','order_hierarchy','parent')],
                               c('goal'='target','name'='target_name','order_hierarchy'='target_order','parent'='target_parent')),
                        data.frame(target        = c('pressures','resilience','spatial'),
                                   target_name   = c('Pressures','Resilience','Spatial'),
                                   target_order  = c(       100 ,        101 ,     102), 
                                   target_parent = c(        NA ,         NA ,      NA), stringsAsFactors=F)),
                  all.x=T)
layer_targets = arrange(merge(layer_targets, layers$meta, by='layer', all.x=T), target_order, name)
layer_targets = within(layer_targets, {
  target_label = sprintf('%s %s', target_order, target_name)
  layer_label  = sprintf('%s (%s)', name, layer)
  }) # [,c('label','value')]

# get unique layer targets
sel_layer_target_choices = with(unique(layer_targets[,c('target','target_label')]), setNames(target, target_label))

# initialize layer variables
lyr_df = subset(layer_targets, target==sel_layer_target_choices[[1]])
sel_layer_choices = with(lyr_df, setNames(layer, layer_label))
lyr_fld_category = lyr_df$fld_category
if (is.na(lyr_fld_category)){
  sel_layer_category_choices = NA
} else {
  sel_layer_category_choices = sort(as.character(unique(layers$data[[lyr_df$layer]][[lyr_fld_category]])))
}
lyr_fld_year = lyr_df$fld_year
if (is.na(lyr_fld_year)){
  sel_layer_year_choices = NA
} else {
  sel_layer_year_choices = sort(unique(layers$data[[lyr_df$layer]][[lyr_fld_year]]), decreasing=T)
}

# Layers: get_var() ----
# reactiveValues ----
dir_scenarios = dirname(dir_scenario)
  
# index or goal
# conf$goals = within(arrange(
#   conf$goals, order_hierarchy), {
#     indented_label = ifelse(!is.na(parent), 
#                             sprintf('. %s', name),
#                             name)})
# varGoals      = c('0. Index'='Index', setNames(conf$goals$goal, conf$goals$indented_label)); # print(names(varGoals))

# 

# add dir for regions
addResourcePath('spatial', path.expand(dir_spatial))

# defaults
smax = 1 # max for goals slider inputs


rgn_names = rbind(rename(SelectLayersData(layers, layers=conf$config$layer_region_labels, narrow=T), c('id_num'='rgn_id', 'val_chr'='rgn_name'))[,c('rgn_id','rgn_name')],
                  data.frame(rgn_id=0, rgn_name='GLOBAL'))

# get goals for aster, all and specific to weights
goals.all = arrange(conf$goals, order_color)[['goal']]

# get colors for aster, based on 10 colors, but extended to all goals. subselect for goals.wts
cols.goals.all = colorRampPalette(RColorBrewer::brewer.pal(10, 'Spectral'), space='Lab')(length(goals.all))
names(cols.goals.all) = goals.all

# helper functions ----
get_wts = function(input){
  #return rescaled goal weights so sums to 1
  wts = c(MAR=input$MAR,
          FIS=input$FIS,    
          AO=input$AO,
          NP=input$NP,
          CS=input$CS,
          CP=input$CP,
          TR=input$TR,
          LIV=input$LIV,
          ECO=input$ECO,
          ICO=input$ICO,
          LSP=input$LSP,
          CW=input$CW,
          HAB=input$HAB,
          SPP=input$SPP)

  # rescale so sums to 1
  wts = wts / sum(wts)
  return(wts)
}

capitalize <- function(s) { # capitalize first letter
  paste(toupper(substr(s, 1, 1)), substr(s, 2, nchar(s)), sep='')
}


# get data
GetMapData = function(v){
  
  brks = with(v$data, seq(min(val_num, na.rm=T),
                              max(val_num, na.rm=T), length.out=8))
  colors = brewer.pal(length(brks)-1, 'Spectral')
  regions = plyr::dlply(v$data, 'rgn_id', function(x) {
    return(list(val_num = x$val_num,
                color   = cut(x$val_num, breaks=brks, labels=colors, include.lowest=TRUE)))
  })                        
  legend = setNames(signif(brks, digits=4), cut(brks, breaks=brks, labels=colors, include.lowest=TRUE)) #; cat(toJSON(legend))
  return(list(regions=regions, legend=legend))
}

# plot map
PlotMap = function(v, width='100%', height='600px'){  
  
  if (length(na.omit(v$data$val_num))==0) stop('Sorry, no data available for the selection.')
      
  d = GetMapData(v)
  
  lmap <- Leaflet$new()
  lmap$mapOpts(worldCopyJump = TRUE)
  lmap$tileLayer(provide='Stamen.TonerLite')
  lmap$set(width=width, height=height)
  lmap$fullScreen(T)
  lmap$setView(c(0, 0), zoom = 3)
  lmap$geoJson(
    "#! regions !#",
    style = sprintf("#! function(feature) {
      regions_data = %s;
      var rgn = feature.properties['rgn_id'].toString();
      if (typeof regions_data[rgn] != 'undefined'){
        var color = regions_data[rgn]['color'];
      } else {
        var color = 'gray';
      };
      return {
        color: color,
        strokeWidth: '1px',
        strokeOpacity: 0.5,
        fillOpacity: 0.2
      }; } !#", gsub('\\\"', "'", toJSON(d$regions, collapse=' '))),
    onEachFeature = sprintf("#! function (feature, layer) {

      // info rollover
      if (document.getElementsByClassName('info leaflet-control').length == 0 ){
        info = L.control({position: 'topright'});  // NOTE: made global b/c not ideal place to put this function
        info.onAdd = function (map) {
          this._div = L.DomUtil.create('div', 'info');
          this.update();
          return this._div;
        };
        info.update = function (props) {
          if (props && typeof props['rgn_id'] != 'undefined' && typeof regions_data[props['rgn_id'].toString()] != 'undefined'){
            var val_num = regions_data[props['rgn_id'].toString()]['val_num'];
          } else {
            var val_num = 'NA';
          };

          this._div.innerHTML = '<h4>%s</h4>' +  (props ?
          	'<b>' + props['rgn_nam'] + '</b> (' + props['rgn_id'] + '): ' + val_num
        		: 'Hover over a region');
        };
        info.addTo(map);
      };
  
      // mouse events
      layer.on({
  
        // mouseover to highlightFeature
    	  mouseover: function (e) {
          var layer = e.target;
          layer.setStyle({
            strokeWidth: '3px',
            strokeOpacity: 0.7,
            fillOpacity: 0.5
          });
        	if (!L.Browser.ie && !L.Browser.opera) {
        		layer.bringToFront();
        	}
  	      info.update(layer.feature.properties);
        },
  
        // mouseout to resetHighlight
  		  mouseout: function (e) {
          geojsonLayer.resetStyle(e.target);
  	      info.update();
        },
  
        // click to zoom
  		  click: function (e) {
          var layer = e.target;        
          if ( feature.geometry.type === 'MultiPolygon' ) {        
          // for multipolygons get true extent
            var bounds = layer.getBounds(); // get the bounds for the first polygon that makes up the multipolygon
            // loop through coordinates array, skip first element as the bounds var represents the bounds for that element
            for ( var i = 1, il = feature.geometry.coordinates[0].length; i < il; i++ ) {
              var ring = feature.geometry.coordinates[0][i];
              var latLngs = ring.map(function(pair) {
                return new L.LatLng(pair[1], pair[0]);
              });
              var nextBounds = new L.LatLngBounds(latLngs);
              bounds.extend(nextBounds);
            }
            map.fitBounds(bounds);
          } else {
          // otherwise use native target bounds
            map.fitBounds(e.target.getBounds());
          }
        }
  	  });
      } !#", HTML(v$name)))
  lmap$legend(position = 'bottomright', 
              colors   =  names(d$legend), 
              labels   =  as.vector(d$legend))
  return(lmap)
}
bbest/ohigui documentation built on May 11, 2019, 9:25 p.m.