# http://www.amazon.com/Lattice-Multivariate-Data-Visualization-Use/dp/0387759689/ref=cm_cr_pr_product_top
library(rbokeh)
library(dplyr)
library(pipeR)

bp <- figure( height = 400, width =  700 ) 

data(Chem97,package = "mlmRev")

##### figure 1_01 ##### 
bp %>%
  ly_hist( gcsescore, Chem97, breaks = seq(0,8,0.5) ) 

# now do the facetted version
lapply(
  as.character(sort(unique(Chem97$score)))
  , function(s){
    figure( 300, 300, title = paste0("Score: ",s) ) %>%
      ly_hist(
        gcsescore
        ,filter(Chem97, score == as.numeric(s))
        ,breaks = seq(0,8,0.5)
      )
  }
) %>%
  grid_plot( nrow = 2, ncol = 3, same_axes=T )

##### figure 1_02 ##### 
bp %>%
  ly_hist( gcsescore, Chem97, breaks = seq(0,8,0.5) ) 

# now do the facetted version
lapply(
  as.character(sort(unique(Chem97$score)))
  , function(s){
    figure( 300, 300, title = paste0("Score: ",s) ) %>%
      ly_density(
        gcsescore
        , data = filter(Chem97, score == as.numeric(s))
        # get error with color mapping
        , color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[as.numeric(s)/2+1],2,7)
      )
  }
) %>>%
  (~show(grid_plot( ., nrow = 2, ncol = 3, same_axes=T ))) %>>%
  (~show(grid_plot( ., nrow = 2, ncol = 3, same_axes=T, byrow = F ))) %>>%
  (~show(grid_plot( ., nrow = 3, ncol = 2, same_axes=T ))) %>>%
  (grid_plot( ., nrow = 3, ncol = 2, same_axes=T, byrow = F ))

##### figure 1_03 ##### 
local({
  bp2<- bp
  lapply(
    as.character(sort(unique(Chem97$score)))
    , function(s){
      bp2 <<- bp2 %>%
        ly_density(
          gcsescore
          , data = filter(Chem97, score == as.numeric(s))
          # get error with color mapping
          , color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[as.numeric(s)/2+1],2,7)
        )
    }
  )
  bp2
})
  
##### figure 2_01 ##### 
data(Oats, package = "MEMSS")

apply(
  unique(expand.grid(
    levels(Oats$Block)
    , levels(Oats$Variety)
    , stringsAsFactors = F )
  )
  , MARGIN = 1
  , function(tuple){
    figure( width = 400, height = 400, title = paste0(tuple) ) %>>%
      ly_lines(
        nitro, yield
        , data =
          Oats %>>%
            filter( Variety == tuple[[2]] & Block == tuple[[1]] ) %>>%
            group_by ( nitro ) %>>%
            summarise ( yield = mean( yield ) )
        , line_color = substr(
            RColorBrewer::brewer.pal(n=3,name="Set1")[which(tuple[[2]]==levels(Oats$Variety))]
          ,2,7
        )
      )
  }
) -> bp2

bp2 %>%
  grid_plot( nrow = 6, ncol = 3, same_axes = T, byrow = F)

##### figure 2_02 ##### 
grid_plot(bp2[seq(1,18,6)], nrow = 1, ncol = 3, same_axes = T )

##### figure 2_06 #####
data(barley,package="lattice")

# no facet to get started
bp %>%
  ly_points( yield, variety, barley, color = year,  hover = list( variety, yield ) )
# now show facet
lapply(
  levels( barley$site )
  ,function(s){
    figure( height = 200, width = 700, title = s ) %>%
      ly_points(
        yield, variety
        # for fun do without dplyr        
        , data = subset(barley, site == s)
        , color = year
        , hover = list( variety, yield )
        , size = 6
      )
  }
) %>%
  grid_plot( nrow = length(.), ncol = 1, same_axes = T )

##### figure 2_07 #####
# no facet first
bp %>%
  ly_lines(
    nitro, yield
    ,data = Oats
    ,color = Variety
    ,group = Variety
  )

# now with facets
lapply(
  levels(Oats$Block)
  ,function(b){
    figure( height = 400, width = 200, title = b ) %>>%
      ly_lines(
        nitro, yield
        ,data = subset( Oats, Block == b )
        ,color = Variety
        ,group = Variety
      )
  }
) %>>%
  grid_plot( nrow = 1, ncol = length(.), same_axes = T )

##### figure 2_08 -  2_11 #####
# bar charts not yet supported but support is in process


##### figure 3_01 #####

data(faithful)

bp %>>%
  # draw the density line using parameters in example
  ly_density( eruptions, faithful, bw = 0.2, n = 200, kernel = "rect" ) %>>%
  # draw density with defaults
  ly_density( eruptions, faithful, color = "blue" ) %>>%
  #add random y to jitter for rugplot of points at bottom
  ly_points(
    eruptions
    # note use of inline expression
    , runif(n = nrow(faithful), min = 0, max = 0.025)
    , faithful
    , size = 5
  )

##### figure 3_02 #####
# like above but a rug plot

bp %>>%
  # draw the density line using parameters in example
  ly_density( eruptions, faithful, bw = 0.2, n = 200, kernel = "rect" ) %>>%
  # sort of a hack but hey it works
  ly_multi_line(
    xs = cbind(faithful$eruptions,faithful$eruptions)
    # note use of inline expression
    , ys = cbind(rep(0,nrow(faithful)),rep(0.025,nrow(faithful)))
  )