- made in R with
rpivotTable,randgeo, and other great pkgs - using JavaScript
pivottableandturfjs - assembled with blockbuilder.org
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.
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()
