rcdimple versions

[timelyportfolio]

Love it, and coincides nicely with rcdimple, so I'll combine the two. The last example gets very close to a complete replication. Could easily make a function to make it one-liner.

library(waffle)
library(pipeR)
library(rcdimple)

#play with example from ?waffle
parts <- c(80, 30, 20, 10)

waffle(parts, rows=8) %>>%
  ggplot_build %>>%
  (.$data[[1]]) %>>%
  na.omit %>>%
  (dat~
    dimple( dat, y~x, type = "bar", groups = "fill" ) %>>%
      xAxis( type = "addCategoryAxis" ) %>>%
      yAxis( type = "addCategoryAxis" ) %>>%
      default_colors( unique( dat$fill ))
  )

parts <- c(`Un-breached\nUS Population`=(318-11-79), `Premera`=11, `Anthem`=79)

waffle(parts, rows=8, size=1, colors=c("#969696", "#1879bf", "#009bda") ) %>>%
  ggplot_build %>>%
  (.$data[[1]]) %>>%
  na.omit %>>%
  (dat~
     dimple( dat, y~x, type = "bar", groups = "fill", height = 200, width = 800 ) %>>%
     xAxis( type = "addCategoryAxis", title  = "One square == 1m ppl" ) %>>%
     yAxis( type = "addCategoryAxis" ) %>>%
     default_colors( unique( dat$fill ) ) %>>%
     set_bounds( x = "5%", y = "10%", width = "80%", height = "70%") %>>%
     add_title("Health records breaches as fraction of US Population")
  )


waffle(parts/10, rows=3, colors=c("#969696", "#1879bf", "#009bda") ) %>>%
  ggplot_build %>>%
  (.$data[[1]]) %>>%
  na.omit %>>%
  (dat~
    dimple( dat, y~x, type = "bar", groups = "fill", height = 200, width = 600 ) %>>%
    xAxis( type = "addCategoryAxis", title  = "One square == 10m ppl" ) %>>%
    yAxis( type = "addCategoryAxis" ) %>>%
    default_colors( unique( dat$fill ) ) %>>%
    set_bounds( x = "5%", y = "10%", width = "80%", height = "70%") %>>%
    add_title("Health records breaches as fraction of US Population")
  )


# replicating an old favourite

# http://graphics8.nytimes.com/images/2008/07/20/business/20debtgraphic.jpg
# http://www.nytimes.com/2008/07/20/business/20debt.html
savings <- c(`Mortgage ($84,911)`=84911, `Auto and\ntuition loans ($14,414)`=14414, `Home equity loans ($10,062)`=10062, `Credit Cards ($8,565)`=8565)
waffle(
  savings/392, rows=7, size=0.5
  , colors=c("#c7d4b6", "#a3aabd", "#a0d0de", "#97b5cf")
) %>>%
  ggplot_build %>>%
  (.$data[[1]]) %>>%
  na.omit %>>%
  (dat~
     dimple( dat, y~x, type = "bar", groups = "fill", height = 300, width = 800 ) %>>%
     xAxis( type = "addCategoryAxis", title  = "1 square == $392" ) %>>%
     yAxis( type = "addCategoryAxis" ) %>>%
     default_colors( unique( dat$fill ) ) %>>%
     set_bounds( x = "5%", y = "10%", width = "80%", height = "70%") %>>%
     add_title("Average Household Savings Each Year")
  )


# do almost everything in one pipe

# similar to but not exact
# https://eagereyes.org/techniques/square-pie-charts
professional <- c(`Male`=44, `Female (56%)`=56)
waffle(
  professional, rows=10, size=0.5
  , colors=c("#af9139", "#544616")
  , title="Professional Workforce Makeup"
) %>>%
  (wf ~
    ggplot_build(wf) %>>%
      (.$data[[1]]) %>>%
      ( data.frame(
        group = wf$scales$scales[[3]]$labels[
          match(wf$data$value,unique(wf$data$value))
        ]
        , .
        , stringAsFactors = F 
      ) ) %>>%
      na.omit %>>%
      (dat~
         dimple( dat, y~x, type = "bar", groups = "group"
           , height = 500, width = 500, barGap = 0.08
         ) %>>%
         xAxis( type = "addCategoryAxis", title  = "" ) %>>%
         yAxis( type = "addCategoryAxis" ) %>>%
         default_colors( unique( dat$fill ) ) %>>%
         set_bounds( x = "5%", y = "10%", width = "65%", height = "70%") %>>%
         add_legend( x = "85%", y = "40%", width = "10%", height = "20%" ) %>>%
         add_title(wf$labels$title)
      )
  ) %>>%
  tack( options = list(tasks = list(
    htmlwidgets::JS(
      'function(){
          this.widgetDimple[0].axes.forEach(function(ax){
            ax.shapes.remove()
          })
      }'
    )
  )))

[abresler]

Was literally JUST thinking about tweeting about this Kent!

[timelyportfolio]

Here is a crude function.

library(waffle)
library(pipeR)
library(rcdimple)


as_rcdimple <- function( wf, height = NULL, width = NULL ){
  ggplot_build(wf) %>>%
    (.$data[[1]]) %>>%
    ( data.frame(
      group = wf$scales$scales[[3]]$labels[
        match(wf$data$value,unique(wf$data$value))
        ]
      , .
      , stringAsFactors = F 
    ) ) %>>%
    na.omit %>>%
    (dat~
       dimple( dat, y~x, type = "bar", groups = "group"
           , height = height, width = width
       ) %>>%
       xAxis( type = "addCategoryAxis", title  = "" ) %>>%
       yAxis( type = "addCategoryAxis", title = "" ) %>>%
       default_colors( unique( dat$fill ) ) %>>%
       set_bounds( x = "5%", y = "10%", width = "65%", height = "70%") %>>%
       add_legend( x = "85%", y = "20%", width = "10%", height = "60%" ) %>>%
       add_title(wf$labels$title)
    ) %>>%
  tack( options = list(tasks = list(
    htmlwidgets::JS(
      'function(){
          this.widgetDimple[0].axes.forEach(function(ax){
            ax.shapes.remove()
          })
      }'
    )
  )))
}

[timelyportfolio]

actually thinking a little more about this prob better to just do this and return a raw dimple. Then the user can adjust as they would like.

as_rcdimple <- function( wf, height = NULL, width = NULL ){
  ggplot_build(wf) %>>%
    (.$data[[1]]) %>>%
    ( data.frame(
      group = wf$scales$scales[[3]]$labels[
        match(wf$data$value,unique(wf$data$value))
        ]
      , .
      , stringAsFactors = F 
    ) ) %>>%
    na.omit %>>%
    (dat~
       dimple( dat, y~x, type = "bar", groups = "group", width = width, height = height   ) %>>%
       xAxis( type = "addCategoryAxis", title  = "" ) %>>%
       yAxis( type = "addCategoryAxis", title = "" ) %>>%
       default_colors( unique( dat$fill ) ) %>>%
       add_title(wf$labels$title)
    ) %>>%
  tack( options = list(tasks = list(
    htmlwidgets::JS(
      'function(){
          this.widgetDimple[0].axes.forEach(function(ax){
            ax.shapes.remove()
          })
      }'
    )
  )))
}

Some things a user might want to do

%>>% tack( options = list(barGap = 0.5) )  # barGap 0  is prob most likely
%>>% set_bounds( x = "5%", y = "10%", width = "65%", height = "70%")
%>>% add_legend( x = "85%", y = "20%", width = "10%", height = "60%" ) 

[timelyportfolio]

Then for a both static and interactive, could do this.

library(htmltools)

savings <- c('Mortgage ($84,911)'=84911, 'Auto and Tuition loans ($14,414)'=14414, 'Home equity loans ($10,062)'=10062, 'Credit Cards ($8,565)'=8565)
waffle(
  savings/392, rows=7, size=0.5
  , colors=c("#c7d4b6", "#a3aabd", "#a0d0de", "#97b5cf"), title = "Waffle Chart Awesomeness"
) %>>%
  (
    tagList(
      HTML(base64::img( shiny::plotPNG(
        function(){print(.)}
        ,height = 200, width = 800
      )))      
      ,as_rcdimple( ., height = 200, width = 800) %>>%
        tack( options = list(barGap = 0) ) %>>%
        add_legend( x = "85%", y = "20%", width = "10%", height = "60%" ) %>>%
        set_bounds( x = "5%", y = "10%", width = "65%", height = "70%")
    )
  ) %>>% html_print

[hrbrmstr]

#added #ty

[timelyportfolio]

Ok cool. I'll do a pull to make a little more robust and also might remove the pipe bit so that another dependency is not introduced.