shotsign: Peter Beshai's Shooting Signatures

In timelyportfolio/shotsignR: d3 Shooting Signatures in R as htmlwidget

Description

Create shooting signatures plots using R and d3.js. Although originally designed for basketball (see discussion), these plots can be used for various data sources.

Usage

shotsign(data, xdomain = NULL, ydomain = NULL, wdomain = NULL,
  colordomain = NULL, width = NULL, height = NULL, margin = list(top =
  20, right = 10, bottom = 20, left = 30), elementId = NULL)

Arguments

data	data.frame with data to plot
xdomain	two element array representing the domain for the x scale
ydomain	two element array representing the domain for the y scale
wdomain	two element array representing the domain for the width scale
colordomain	two element array representing the domain for the color scale
width,height	valid CSS unit for the height and width of the htmlwidget container div
margin	named list of margins for plotting window. For more details, see Mike Bostock's explanation
elementId	character for a custom id

Examples

# devtools::install_github("timelyportfolio/shotsignR")

library("shotsignR")

# use data from Peter Beshai gist https://gist.github.com/pbeshai/ffd0f9d84b4e8df27db2
test_data <- jsonlite::fromJSON(
  '[{"x":0,"y":0.7984084880636605,"widthValue":158,"colorValue":0.1629224750896936},{"x":1,"y":0.765993265993266,"widthValue":145,"colorValue":0.16595424641159695},{"x":2,"y":0.7241379310344827,"widthValue":74,"colorValue":0.14788844079931118},{"x":3,"y":0.6082191780821917,"widthValue":36,"colorValue":0.09604064011114222},{"x":4,"y":0.45348837209302323,"widthValue":35,"colorValue":0.0205093443427537},{"x":5,"y":0.37333333333333335,"widthValue":39,"colorValue":-0.015647382920110142},{"x":6,"y":0.3744075829383886,"widthValue":39,"colorValue":-0.012850902701298128},{"x":7,"y":0.3926940639269407,"widthValue":37,"colorValue":0.0016039868744902042},{"x":8,"y":0.4619047619047619,"widthValue":22,"colorValue":0.07160931036145685},{"x":9,"y":0.4788135593220339,"widthValue":45,"colorValue":0.0874320387619314},{"x":10,"y":0.4979423868312757,"widthValue":45,"colorValue":0.10551911317398666},{"x":11,"y":0.4542253521126761,"widthValue":42,"colorValue":0.06070052516549129},{"x":12,"y":0.4503311258278146,"widthValue":44,"colorValue":0.05378653654579513},{"x":13,"y":0.4110787172011662,"widthValue":66,"colorValue":0.009121101429431566},{"x":14,"y":0.4196185286103542,"widthValue":61,"colorValue":0.01780232246319491},{"x":15,"y":0.42819148936170215,"widthValue":64,"colorValue":0.02163884827966278},{"x":16,"y":0.41988950276243087,"widthValue":71,"colorValue":0.016918338868285643},{"x":17,"y":0.45425867507886436,"widthValue":50,"colorValue":0.04975728463782164},{"x":18,"y":0.4141791044776119,"widthValue":45,"colorValue":0.015415540872963762},{"x":19,"y":0.4752475247524752,"widthValue":37,"colorValue":0.07919199741203164},{"x":20,"y":0.41830065359477125,"widthValue":20,"colorValue":0.030376008752275918},{"x":21,"y":0.4928571428571429,"widthValue":13,"colorValue":0.10821499731174294},{"x":22,"y":0.45592705167173253,"widthValue":18,"colorValue":0.07432771905345104},{"x":23,"y":0.43107221006564544,"widthValue":39,"colorValue":0.05587993676927633},{"x":24,"y":0.4125364431486881,"widthValue":221,"colorValue":0.041212020305431696},{"x":25,"y":0.3859060402684564,"widthValue":127,"colorValue":0.023158322960854794},{"x":26,"y":0.36511156186612576,"widthValue":60,"colorValue":0.00876771640727797},{"x":27,"y":0.32627118644067793,"widthValue":22,"colorValue":-0.017285514590249906},{"x":28,"y":0.25555555555555554,"widthValue":3,"colorValue":-0.07036667774454414},{"x":29,"y":0.34375,"widthValue":2,"colorValue":0.043655332912590716},{"x":30,"y":0.2,"widthValue":0,"colorValue":-0.06235399820305482}]'
)

shotsign( test_data )


# now let's try the example from
#  issue https://github.com/timelyportfolio/buildingwidgets/issues/14
library(dplyr)
library(magrittr)
library(ggplot2)

x <- read.table("http://www.stat.ufl.edu/~winner/data/ecophys_rc.dat") %>% 
  setNames(c("location", "treatment", "plant_id", "co2_concentration", "co2_uptake_rate")) %>% 
  group_by(plant_id) %>% 
  mutate(time = 1:n()) %>% 
  ungroup()
x

x %>% 
  filter(plant_id == 1) %>% 
  qplot(time, co2_uptake_rate, data = ., geom = "line", group = plant_id, 
        colour = co2_concentration, size = co2_concentration)

x %>% 
  filter(plant_id == 1) %>%
  select(time, co2_uptake_rate, co2_concentration, co2_concentration) %>%
  set_colnames(c("x","y","widthValue")) %>%
  mutate(colorValue = widthValue/max(widthValue)) %>%
  {
    shotsign(
      .,
      xdomain = range(.$x),
      ydomain = range(.$y),
      wdomain = range(.$widthValue),
      colordomain = c(0,1)
    )
  }

# finance example
#  allocation by key rate duration
#  use data from https://mpra.ub.uni-muenchen.de/46057/1/MPRA_paper_46057.pdf
#  figure 5
krd_data <- data.frame(
  x = c(1/12,3/12,6/12,1,2), 
  y = c(.2,.1,.5,.15,.05), # made up allocation
  # difference in portfolio and benchmark return
  widthValue = c(0.01,-0.04,-0.11,0.14,0.06),
  colorValue = c(0.01,-0.04,-0.11,0.14,0.06)
)

ss <- shotsign(
  krd_data,
  xdomain = range(krd_data$x),
  ydomain = c(-0.1,0.5),
  wdomain = c(0.2,-0.2),
  colordomain = c(0.2,-0.2),
  height = 300,
  width = 600
)

ss$x$tasks <- list(
  htmlwidgets::JS(
'
function(){
  d3.select(this).select("svg").append("text")
    .attr("x","590")
    .attr("y","290")
    .style("text-anchor","end")
    .text("Key Rate Duration")

  d3.select(this).select("svg").append("text")
      .attr("x",-20)
      .attr("y",20)
      .attr("transform", "rotate(-90)")
      .style("text-anchor","end")
      .text("Allocation")
}
'
  )
)

ss

timelyportfolio/shotsignR documentation built on May 31, 2019, 2:13 p.m.