rpivotTable
, randgeo
, and other great pkgspivottable
and turfjs
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()