geo pivot table of US states with turf from R

• 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?! *

However based on social media response, geo pivot tables don’t seem as amazing as I first thought, or perhaps it is the example. Here is one more try using real data from US states.

library(geojsonio)
library(purrr)
library(tibble)
library(magrittr)
library(htmltools)
library(rpivotTable)
library(leaflet)

# get geojson for all the states to use in our geo pivot
states_gj <- map(
  state.name,
  ~geojson_read(
    x=sprintf("https://rawgit.com/glynnbird/usstatesgeojson/master/%s.geojson",tolower(.x)),
    method="local",
    what="list"
  )
)

states_tbl <- tibble(
  abb = state.abb,
  name = state.name,
  division = state.division,
  gj = states_gj
)

rpvt <- rpivotTable(
  states_tbl,
  aggregators = htmlwidgets::JS(
    '{turf_centroid: turf_centroid(), turf_centermass: turf_centermass(), turf_convex: turf_convex()}'
  ),
  onRefresh = htmlwidgets::JS(
"
function(config) {
debugger;
  var feats_total = [];
  $('.pvtTotal, .pvtGrandTotal').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
      };
    };
  };
}

var turf_convex = 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.convex(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()