All examples By author By category About

timelyportfolio

R pivottable with simple-statistics correl on perf data

see rpivotTable issue


Code

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()