geo pivot table with turf and leaflet

• made in R with rpivotTable, randgeo, and other great pkgs
• using JavaScript pivottable and turfjs
• assembled with blockbuilder.org

Great Idea - Geo Pivot Table

I had this idea yesterday afternoon as I combined Tom MacWright’s library simple-statistics for custom aggregation in Nicolas Kructhen’s amazing pivottable. Well, Tom works at Mapbox, and I have been doing some geo recently, so I thought

*Wouldn’t a geo pivot table be something amazing?! *

Last night the example didn’t have a leaflet map, so I have added a map for visualization of the results.

Code

library(rpivotTable)
library(tibble)
library(randgeo)
library(htmltools)
library(dplyr)
library(leaflet)

n = 30
df_geos <- tibble(
  ltr_cat = letters[floor(runif(n, 1, 5))],
  rand_poly = lapply(1:n, function(x) {geo_polygon(count=10)})
)

rpvt <- rpivotTable(
  df_geos,
  aggregators = htmlwidgets::JS(
    '{turf_centroid: turf_centroid(), turf_centermass: turf_centermass()}'
  ),
  onRefresh = htmlwidgets::JS(
"
function(config) {
debugger;
  var feats_total = [];
  $('.pvtTotal').each(
    function(i,d){feats_total.push(JSON.parse(d.innerText))}
  );
  var map = HTMLWidgets.find('.leaflet').getMap();

  map.layerManager.clearGroup('pivots');

  var gj = L.geoJSON(feats_total);
  map.layerManager.addLayer(gj,null,null,'pivots');
}
"
  )
)

# rpivotTable auto boxes everything except inclusions and exclusions
#  https://github.com/smartinsightsfromdata/rpivotTable/blame/master/R/rpivotTable.R#L110-L117
#  so we need to unbox or unlist
rpvt$x$params$aggregators <- rpvt$x$params$aggregators[[1]]

tagList(
  tags$script(src = "https://unpkg.com/@turf/turf/turf.min.js"),
  tags$script(
"
var turf_centroid = function(formatter) {
  if (formatter == null) {
    formatter = function(d){return JSON.stringify(d)}
  }
  return function(arg) {
    var attr;
    attr = arg[0];
    return function(data, rowKey, colKey) {
      return {
        arr: [],
        push: function(record) {
          var that = this;
          if(attr) {record[attr].features.forEach(function(d) {that.arr.push(d)});}
        },
        value: function() {
          return typeof(this.arr[0]) !== 'undefined'  ?
            turf.centroid(turf.featureCollection(this.arr)) :
            null;
        },
        format: formatter,
        numInputs: attr != null ? 0 : 1
      };
    };
  };
}

var turf_centermass = function(formatter) {
  if (formatter == null) {
    formatter = function(d){return JSON.stringify(d)}
  }
  return function(arg) {
    var attr;
    attr = arg[0];
    return function(data, rowKey, colKey) {
      return {
        arr: [],
        push: function(record) {
          var that = this;
          if(attr) {record[attr].features.forEach(function(d) {that.arr.push(d)});}
        },
        value: function() {
          return this.arr.length  ?
            turf.centerOfMass(turf.featureCollection(this.arr)) :
            null;
        },
        format: formatter,
        numInputs: attr != null ? 0 : 1
      };
    };
  };
}
"
  ),
  tags$div(style="width:400px;display:inline;float:left;",leaflet() %>% addTiles()),
  tags$div(style="width:400px;display:inline;float:left;",rpvt)

) %>%
  browsable()