see rpivotTable
issue
library(dplyr)
library(htmlwidgets)
library(rpivotTable)
library(htmltools)
library(PerformanceAnalytics)
data(managers)
rpvt <- rpivotTable(
data.frame(
date = as.numeric(format(index(managers),"%Y")),
managers,
stringsAsFactors = FALSE
)[,c(1,2,4,5,9,10,11)],
aggregators = htmlwidgets::JS('{ss_quantile25: ss_quantile25(), ss_median: median(), ss_correlation: correlation()}')
)
# 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/simple-statistics@4.0.0/dist/simple-statistics.min.js"),
tags$script(HTML(
"
var ss_quantile25 = function(formatter) {
if (formatter == null) {
formatter = $.pivotUtilities.numberFormat();
}
return function(arg) {
var attr;
attr = arg[0];
return function(data, rowKey, colKey) {
return {
arr: [],
push: function(record) {
if (!isNaN(parseFloat(record[attr]))) {
this.arr.push(parseFloat(record[attr]));
}
},
value: function() {
return this.arr.length ? ss.quantile(this.arr, 0.25) : null;
},
format: formatter,
numInputs: attr != null ? 0 : 1
};
};
};
}
var median = function(formatter) {
if (formatter == null) {
formatter = $.pivotUtilities.numberFormat();
}
return function(arg) {
var attr;
attr = arg[0];
return function(data, rowKey, colKey) {
return {
arr: [],
push: function(record) {
if (!isNaN(parseFloat(record[attr]))) {
this.arr.push(parseFloat(record[attr]));
}
},
value: function() {
return this.arr.length ? ss.median(this.arr) : null;
},
format: formatter,
numInputs: attr != null ? 0 : 1
};
};
};
};
var correlation = function(formatter) {
if (formatter == null) {
formatter = $.pivotUtilities.numberFormat();
}
return function(arg) {
var attrX, attrY;
attrX = arg[0];
attrY = arg[1];
return function(data, rowKey, colKey) {
return {
arrX: [],
arrY: [],
push: function(record) {
if (!isNaN(parseFloat(record[attrX]))) {
this.arrX.push(parseFloat(record[attrX]));
}
if (!isNaN(parseFloat(record[attrY]))) {
this.arrY.push(parseFloat(record[attrY]));
}
},
value: function() {
return this.arrX.length && this.arrY.length ? ss.sampleCorrelation(this.arrX, this.arrY) : null;
},
format: formatter,
numInputs: (attrX != null) && (attrY != null) ? 0 : 2
};
};
};
};
"
)),
rpvt
) %>%
browsable()