Skip to content

Instantly share code, notes, and snippets.

@timelyportfolio

timelyportfolio/Readme.md

Last active March 30, 2020 06:14
Show Gist options
  • Save timelyportfolio/8300c43ac43d772600df to your computer and use it in GitHub Desktop.
Save timelyportfolio/8300c43ac43d772600df to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. timelyportfolio revised this gist Feb 18, 2015. 1 changed file with 7 additions and 2 deletions.
    9 changes: 7 additions & 2 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -487,7 +487,6 @@ figure( height = 400, width = 700, xlim = as.character(seq(4,6.5,0.1)) ) %>>%

    ##### figure 3_17 #######
    # again, not sure jitter possible with categorical scale/axis
    # also, no line for now, but can do
    data(barley,package="lattice")

    barley %>>%
    @@ -499,7 +498,7 @@ barley %>>%
    ) %>>%
    (dat~
    ly_points(
    figure( width = 700, height = 400 )
    figure( width = 700, height = 400, xlim = levels(dat$site) )
    ,site
    ,residuals
    ,data = dat
    @@ -512,5 +511,11 @@ barley %>>%
    ,data = dat %>>% group_by( site, year ) %>>% summarize( median_residual = median(residuals) )
    ,glyph = 3
    ,size = 30
    ) %>>%
    ly_lines(
    site
    ,median_residual
    ,color = year
    ,data = dat %>>% group_by( site, year ) %>>% summarize( median_residual = median(residuals) )
    )
    )
  2. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 43 additions and 0 deletions.
    43 changes: 43 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -471,3 +471,46 @@ figure( height = 400, width = 700, ylim = as.character(seq(4,6.5,0.1)) ) %>>%
    ,alpha = 1
    )

    ##### figure 3_16 #######
    # don't think the jitter is possible with a categorical scale/axis
    data(quakes)

    figure( height = 400, width = 700, xlim = as.character(seq(4,6.5,0.1)) ) %>>%
    ly_points(
    factor(mag)
    ,depth
    ,data = quakes
    ,size = 4
    ,color = "black"
    ,alpha = 1
    )

    ##### figure 3_17 #######
    # again, not sure jitter possible with categorical scale/axis
    # also, no line for now, but can do
    data(barley,package="lattice")

    barley %>>%
    (
    data.frame(
    .
    ,residuals = sqrt(abs(residuals(lm(yield~variety+year+site,.))))
    )
    ) %>>%
    (dat~
    ly_points(
    figure( width = 700, height = 400 )
    ,site
    ,residuals
    ,data = dat
    ,color = year
    ) %>>%
    ly_points(
    site
    ,median_residual
    ,color = year
    ,data = dat %>>% group_by( site, year ) %>>% summarize( median_residual = median(residuals) )
    ,glyph = 3
    ,size = 30
    )
    )
  3. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 15 additions and 0 deletions.
    15 changes: 15 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -456,3 +456,18 @@ lapply(
    }
    ) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )


    ##### figure 3_15 #######
    data(quakes)

    figure( height = 400, width = 700, ylim = as.character(seq(4,6.5,0.1)) ) %>>%
    ly_points(
    depth
    ,factor(mag)
    ,data = quakes
    ,size = 4
    ,color = "black"
    ,alpha = 1
    )

  4. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 18 additions and 1 deletion.
    19 changes: 18 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -417,6 +417,14 @@ lapply(
    ,gcsescore
    ,data = filter(Chem97, gender == g)
    ) %>>%
    ly_lines(
    as.character(score)
    ,mean_gcse
    ,data = filter(Chem97, gender == g) %>>%
    group_by( score) %>>%
    summarize( mean_gcse = mean(gcsescore) )
    , color = "black"
    ) %>>%
    x_axis(label = "Average GCSE Score")
    }
    ) %>>%
    @@ -435,7 +443,16 @@ lapply(
    gender
    ,gcsescore
    ,data = filter(Chem97, score == s)
    )
    ) %>>%
    ly_points(
    gender
    ,mean_gcse
    ,data = filter(Chem97, score == s) %>>%
    group_by( gender ) %>>%
    summarize( mean_gcse = mean(gcsescore) )
    , color = "black"
    , glyph = 9
    )
    }
    ) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )
  5. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 19 additions and 1 deletion.
    20 changes: 19 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -420,4 +420,22 @@ lapply(
    x_axis(label = "Average GCSE Score")
    }
    ) %>>%
    grid_plot( nrow = 1, ncol = 2 )#, same_axes messes up sort )
    grid_plot( nrow = 1, ncol = 2 )#, same_axes messes up sort )


    ##### figure 3_12 #######
    data(Chem97, package = "mlmRev")

    lapply(
    sort(unique(Chem97$score))
    ,function(s){
    # non facet first since first boxplot
    figure( width = 200, height = 500, title = paste0("score: ", s) ) %>>%
    ly_boxplot(
    gender
    ,gcsescore
    ,data = filter(Chem97, score == s)
    )
    }
    ) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )
  6. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 35 additions and 0 deletions.
    35 changes: 35 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -386,3 +386,38 @@ Chem97 %>>%
    )
    ) %>>%
    grid_plot( nrow = 2, ncol = 3, same_axes = T )


    ##### figure 3_11 #######
    data(Chem97, package = "mlmRev")

    # non facet first since first boxplot
    figure( width = 700, height = 400
    # little clunky to force sort on categorical axis
    , xlim = as.character(sort(unique(Chem97$score)))
    ) %>>%
    ly_boxplot(
    as.character(score)
    ,gcsescore
    ,data = Chem97
    ) %>>%
    x_axis(label = "Average GCSE Score")

    # now facet it
    lapply(
    levels(Chem97$gender)
    ,function(g){
    # non facet first since first boxplot
    figure( width = 500, height = 300
    # little clunky to force sort on categorical axis
    , xlim = as.character(sort(unique(Chem97$score)))
    ) %>>%
    ly_boxplot(
    as.character(score)
    ,gcsescore
    ,data = filter(Chem97, gender == g)
    ) %>>%
    x_axis(label = "Average GCSE Score")
    }
    ) %>>%
    grid_plot( nrow = 1, ncol = 2 )#, same_axes messes up sort )
  7. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 39 additions and 3 deletions.
    42 changes: 39 additions & 3 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -254,6 +254,7 @@ grid_plot( nrow = 1, ncol = 2, same_axes = T )

    ##### figure 3_08 #######
    # use a less functional approach to get the data in ECDF form
    data(Chem97, package = "mlmRev")
    data <- data.frame()
    gender <- unique(Chem97$gender)
    scores <- unique(Chem97$score)
    @@ -338,9 +339,11 @@ local({
    ,y = y1
    ,data = subset(data, score == s & gender == y )
    ,color = gender
    ,size = 3
    ,size = 1
    ,hover = list(x1,y1)
    )
    ) %>>%
    x_axis( label = "Std Normal ") %>>%
    y_axis( label = "GCSEScore")
    }
    ,levels(data$gender)
    ,init = levels(data$gender)[1]
    @@ -349,4 +352,37 @@ local({
    }
    )
    }) %>>%
    grid_plot( nrow = 1, ncol = 63, same_axes = T )
    grid_plot( nrow = 1, ncol = 6, same_axes = T )


    ##### figure 3_10 #######
    data(Chem97, package = "mlmRev")

    Chem97 %>>%
    dplyr::group_by( gender, score ) %>%
    do(
    data.frame(
    x = qnorm(ppoints(100))
    ,y = quantile(.$gcsescore, ppoints(100), names = F, type = 7, na.rm = F)
    ,score = unique(.$score)
    ,gender = unique(.$gender)
    )
    ) %>>%
    (reshape2::dcast(., x + score ~ gender, value.var = "y")) %>>%
    (dat~
    lapply(
    sort(unique(dat$score))
    ,function(s){
    figure( width = 200, height = 200, title = paste0("score: ", s) ) %>>%
    ly_points(
    M
    ,F
    ,data = filter( dat, score == s )
    ,size = 4
    ,hover = list(score,M,F)
    ) %>>%
    ly_abline( a= 0, b = 1 )
    }
    )
    ) %>>%
    grid_plot( nrow = 2, ncol = 3, same_axes = T )
  8. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 6 additions and 2 deletions.
    8 changes: 6 additions & 2 deletions examples_ggplot2.R
    View file
    Original file line number Diff line number Diff line change
    @@ -1,6 +1,10 @@
    # examples from ggplot2 book
    # http://www.amazon.com/ggplot2-Elegant-Graphics-Data-Analysis/dp/0387981403/ref=sr_1_1?ie=UTF8&qid=1423697224&sr=8-1&keywords=ggplot2
    data(diamonds, package = "ggplot2")

    library(rbokeh)
    library(ggplot2)

    data(diamonds)

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

    @@ -16,7 +20,7 @@ lapply(
    levels(unique(diamonds$color))
    ,function(c){
    figure( height = 300, width = 300, title = paste0("Color: ",c) ) %>%
    ly_hexbin( carat, price, diamonds[which(diamonds$color==c),] )
    ly_hexbin( carat, log(price), diamonds[which(diamonds$color==c),] )
    }
    ) %>%
    grid_plot( nrow = 3, ncol = 3, same_axes = T )
  9. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 53 additions and 1 deletion.
    54 changes: 53 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -286,7 +286,7 @@ local({
    ,y = y1
    ,data = subset(data, score == s & gender == y )
    ,color = gender
    ,size = 5
    ,size = 3
    )
    }
    ,levels(data$gender)
    @@ -298,3 +298,55 @@ local({
    }) %>>%
    grid_plot( nrow = 2, ncol = 3, same_axes = T )



    ##### figure 3_09 #######
    data(Chem97, package = "mlmRev")
    data <- data.frame()
    gender <- unique(Chem97$gender)
    scores <- unique(Chem97$score)
    for (i in 1 : length(scores) ) {
    for (j in 1 : length(gender) ) {
    tempdata <- list()
    #code primarily from lattice panel.qqmath
    n <- sum(!is.na( Chem97[which(Chem97$gcsescore > 0 & Chem97$score == scores[i] & Chem97$gender == gender[j] ),]$gcsescore))
    tempdata$x = qunif(ppoints(n))
    tempdata$y = quantile(
    x = Chem97[which(Chem97$gcsescore > 0 & Chem97$score == scores[i] & Chem97$gender == gender[j] ),]$gcsescore,
    ppoints(n),
    names = FALSE,
    type = 7,
    na.rm = TRUE)
    tempdata$gender = rep( gender[j], n )
    tempdata$score = rep(scores[i], n )
    data <- rbind( data, data.frame( tempdata ) )
    }
    }
    colnames(data) <- c("x1", "y1", "gender", "score")

    local({
    lapply(
    sort(unique(data$score))
    ,function(s){
    bp <- figure( width = 200 , height = 500, title = paste0("Score: ", s) )
    Reduce(
    function(x,y){
    print(y)
    bp <<- ly_points(
    bp
    ,x = x1
    ,y = y1
    ,data = subset(data, score == s & gender == y )
    ,color = gender
    ,size = 3
    ,hover = list(x1,y1)
    )
    }
    ,levels(data$gender)
    ,init = levels(data$gender)[1]
    )
    return(bp)
    }
    )
    }) %>>%
    grid_plot( nrow = 1, ncol = 63, same_axes = T )
  10. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 8 additions and 6 deletions.
    14 changes: 8 additions & 6 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -270,7 +270,7 @@ for (i in 1 : length(scores) ) {
    data <- rbind( data, data.frame( tempdata ) )
    }
    }
    colnames(data) <- c("x", "y", "gender", "score")
    colnames(data) <- c("x1", "y1", "gender", "score")

    local({
    lapply(
    @@ -279,20 +279,22 @@ local({
    bp <- figure( width = 300 , height = 300, title = paste0("Score: ", s) )
    Reduce(
    function(x,y){
    print(y)
    bp <<- ly_points(
    bp
    ,x = x
    ,y = y
    ,data = subset(data, score == s & gender == y)
    ,color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[which(levels(data$gender)==y)],2,7)
    ,x = x1
    ,y = y1
    ,data = subset(data, score == s & gender == y )
    ,color = gender
    ,size = 5
    )
    }
    ,levels(data$gender)
    ,init = levels(data$gender)[1]
    )
    return(bp)
    }
    )
    }) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )
    grid_plot( nrow = 2, ncol = 3, same_axes = T )

  11. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 47 additions and 9 deletions.
    56 changes: 47 additions & 9 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -200,14 +200,6 @@ lapply(

    ##### figure 3_05 ########
    data(Chem97, package = "mlmRev")
    #plyr code from Ramnath Vaidyanathan
    #eases the data manipulation considerably
    #calculate qnorm and quantile for each score
    require(plyr)
    data <- ddply(Chem97, .(score), summarize,
    x = qnorm(ppoints(100)),
    y = quantile(gcsescore, ppoints(100), names = F, type = 7, na.rm = F)
    )

    # no facet first for simplicity
    # since first example of ly_quantile
    @@ -245,7 +237,7 @@ local({
    bp <<- ly_quantile(
    bp
    ,x = gcsescore
    ,data = subset(Chem97,score == y & gender == g)
    ,data = subset(Chem97, score == y & gender == g)
    ,distn = qnorm
    ,color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[as.numeric(y)/2+1],2,7)
    ,size = 5
    @@ -258,3 +250,49 @@ local({
    )
    }) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )


    ##### figure 3_08 #######
    # use a less functional approach to get the data in ECDF form
    data <- data.frame()
    gender <- unique(Chem97$gender)
    scores <- unique(Chem97$score)
    for (i in 1 : length(scores) ) {
    for (j in 1 : length(gender) ) {
    tempdata <- list()
    #code primarily from lattice panel.ecdfplot
    #note: example subset gcsescore > 0
    n = sum(!is.na(Chem97[which( Chem97$gender == gender[j] & Chem97$score == scores[i] & Chem97$gcsescore > 0 ),]$gcsescore))
    tempdata$x = sort(Chem97[which( Chem97$gender == gender[j] & Chem97$score == scores[i] & Chem97$gcsescore > 0 ),]$gcsescore)
    tempdata$y = seq_len(n)/n
    tempdata$gender = rep( gender[j], length(tempdata$x) )
    tempdata$score = rep(scores[i], length(tempdata$x) )
    data <- rbind( data, data.frame( tempdata ) )
    }
    }
    colnames(data) <- c("x", "y", "gender", "score")

    local({
    lapply(
    sort(unique(data$score))
    ,function(s){
    bp <- figure( width = 300 , height = 300, title = paste0("Score: ", s) )
    Reduce(
    function(x,y){
    bp <<- ly_points(
    bp
    ,x = x
    ,y = y
    ,data = subset(data, score == s & gender == y)
    ,color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[which(levels(data$gender)==y)],2,7)
    ,size = 5
    )
    }
    ,levels(data$gender)
    )
    return(bp)
    }
    )
    }) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )

  12. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 27 additions and 1 deletion.
    28 changes: 27 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -231,4 +231,30 @@ lapply(
    )
    }
    ) %>>%
    grid_plot( nrow = 2, ncol = 3, same_axes = T )
    grid_plot( nrow = 2, ncol = 3, same_axes = T )


    ##### figure 3_06 ########
    local({
    lapply(
    levels(Chem97$gender)
    ,function(g){
    bp <- figure( width = 300 , height = 300, title = paste0("Gender: ", g) )
    Reduce(
    function(x,y){
    bp <<- ly_quantile(
    bp
    ,x = gcsescore
    ,data = subset(Chem97,score == y & gender == g)
    ,distn = qnorm
    ,color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[as.numeric(y)/2+1],2,7)
    ,size = 5
    )
    }
    ,sort(unique(Chem97$score))
    )
    return(bp)
    }
    )
    }) %>>%
    grid_plot( nrow = 1, ncol = 2, same_axes = T )
  13. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 36 additions and 0 deletions.
    36 changes: 36 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -196,3 +196,39 @@ lapply(
    }
    ) %>>%
    grid_plot( nrow = 4, ncol = 2, same_axes = T )


    ##### figure 3_05 ########
    data(Chem97, package = "mlmRev")
    #plyr code from Ramnath Vaidyanathan
    #eases the data manipulation considerably
    #calculate qnorm and quantile for each score
    require(plyr)
    data <- ddply(Chem97, .(score), summarize,
    x = qnorm(ppoints(100)),
    y = quantile(gcsescore, ppoints(100), names = F, type = 7, na.rm = F)
    )

    # no facet first for simplicity
    # since first example of ly_quantile
    bp %>>%
    ly_quantile(
    x = gcsescore
    ,group = score
    ,data = Chem97
    ,distn = qnorm
    )

    lapply(
    sort(unique(Chem97$score))
    ,function(d){
    figure( width = 300 , height = 300, title = paste0("Score: ", d) ) %>>%
    ly_quantile(
    x = gcsescore
    ,data = subset(Chem97,score == d)
    ,distn = qnorm
    ,color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[as.numeric(d)/2+1],2,7)
    )
    }
    ) %>>%
    grid_plot( nrow = 2, ncol = 3, same_axes = T )
  14. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 17 additions and 1 deletion.
    18 changes: 17 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -179,4 +179,20 @@ bp %>>%
    xs = cbind(faithful$eruptions,faithful$eruptions)
    # note use of inline expression
    , ys = cbind(rep(0,nrow(faithful)),rep(0.025,nrow(faithful)))
    )
    )


    ##### figure 3_03 ########
    data(gvhd10, package = "latticeExtra")
    #get density data for the plot
    lapply(
    levels(gvhd10$Days)
    ,function(d){
    figure( height = 200, width = 400, title = paste0("Days: ", d) ) %>>%
    ly_density(
    log(FSC.H)
    ,data = subset(gvhd10, Days == d)
    )
    }
    ) %>>%
    grid_plot( nrow = 4, ncol = 2, same_axes = T )
  15. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 14 additions and 1 deletion.
    15 changes: 14 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -158,7 +158,7 @@ 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 = "lightgray" ) %>>%
    ly_density( eruptions, faithful, color = "blue" ) %>>%
    #add random y to jitter for rugplot of points at bottom
    ly_points(
    eruptions
    @@ -167,3 +167,16 @@ bp %>>%
    , 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)))
    )
  16. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 23 additions and 1 deletion.
    24 changes: 23 additions & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -144,4 +144,26 @@ lapply(
    )
    }
    ) %>>%
    grid_plot( nrow = 1, ncol = length(.), same_axes = T )
    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 = "lightgray" ) %>>%
    #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
    )
  17. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 1 addition and 2 deletions.
    3 changes: 1 addition & 2 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -90,10 +90,9 @@ apply(
    )
    )
    }
    ) %>>% unname -> bp2
    ) -> bp2

    bp2 %>%
    # does not work ; get blank screen
    grid_plot( nrow = 6, ncol = 3, same_axes = T, byrow = F)

    ##### figure 2_02 #####
  18. timelyportfolio revised this gist Feb 17, 2015. 1 changed file with 7 additions and 4 deletions.
    11 changes: 7 additions & 4 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -41,8 +41,11 @@ lapply(
    , color = substr(RColorBrewer::brewer.pal(name="Dark2",n=6)[as.numeric(s)/2+1],2,7)
    )
    }
    ) %>%
    grid_plot( nrow = 2, ncol = 3, same_axes=T )
    ) %>>%
    (~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({
    @@ -133,13 +136,13 @@ bp %>%
    lapply(
    levels(Oats$Block)
    ,function(b){
    figure( height = 400, width = 200, title = 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 )
  19. timelyportfolio revised this gist Feb 12, 2015. 1 changed file with 48 additions and 0 deletions.
    48 changes: 48 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -95,3 +95,51 @@ bp2 %>%

    ##### 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 )
  20. timelyportfolio revised this gist Feb 12, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -94,4 +94,4 @@ bp2 %>%
    grid_plot( nrow = 6, ncol = 3, same_axes = T, byrow = F)

    ##### figure 2_02 #####
    grid_plot(bp2[1:3], nrow = 1, ncol = 3, same_axes = T )
    grid_plot(bp2[seq(1,18,6)], nrow = 1, ncol = 3, same_axes = T )
  21. timelyportfolio revised this gist Feb 12, 2015. 1 changed file with 35 additions and 2 deletions.
    37 changes: 35 additions & 2 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -1,5 +1,7 @@
    # 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 )

    @@ -10,7 +12,6 @@ bp %>%
    ly_hist( gcsescore, Chem97, breaks = seq(0,8,0.5) )

    # now do the facetted version
    library(dplyr)
    lapply(
    as.character(sort(unique(Chem97$score)))
    , function(s){
    @@ -29,7 +30,6 @@ bp %>%
    ly_hist( gcsescore, Chem97, breaks = seq(0,8,0.5) )

    # now do the facetted version
    library(dplyr)
    lapply(
    as.character(sort(unique(Chem97$score)))
    , function(s){
    @@ -62,3 +62,36 @@ local({
    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
    )
    )
    }
    ) %>>% unname -> bp2

    bp2 %>%
    # does not work ; get blank screen
    grid_plot( nrow = 6, ncol = 3, same_axes = T, byrow = F)

    ##### figure 2_02 #####
    grid_plot(bp2[1:3], nrow = 1, ncol = 3, same_axes = T )
  22. timelyportfolio revised this gist Feb 11, 2015. 1 changed file with 20 additions and 2 deletions.
    22 changes: 20 additions & 2 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -1,5 +1,4 @@
    # http://www.amazon.com/Lattice-Multivariate-Data-Visualization-Use/dp/0387759689/ref=cm_cr_pr_product_top

    library(rbokeh)

    bp <- figure( height = 400, width = 700 )
    @@ -43,4 +42,23 @@ lapply(
    )
    }
    ) %>%
    grid_plot( nrow = 2, ncol = 3, same_axes=T )
    grid_plot( nrow = 2, ncol = 3, same_axes=T )

    ##### 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
    })

  23. timelyportfolio revised this gist Feb 11, 2015. 2 changed files with 3 additions and 0 deletions.
    1 change: 1 addition & 0 deletions examples_ggplot2.R
    View file
    Original file line number Diff line number Diff line change
    @@ -1,4 +1,5 @@
    # examples from ggplot2 book
    # http://www.amazon.com/ggplot2-Elegant-Graphics-Data-Analysis/dp/0387981403/ref=sr_1_1?ie=UTF8&qid=1423697224&sr=8-1&keywords=ggplot2
    data(diamonds, package = "ggplot2")

    bp <- figure( height = 400, width = 700 )
    2 changes: 2 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -1,3 +1,5 @@
    # http://www.amazon.com/Lattice-Multivariate-Data-Visualization-Use/dp/0387759689/ref=cm_cr_pr_product_top

    library(rbokeh)

    bp <- figure( height = 400, width = 700 )
  24. timelyportfolio revised this gist Feb 11, 2015. 3 changed files with 52 additions and 0 deletions.
    8 changes: 8 additions & 0 deletions Readme.md
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,8 @@
    ### lattice

    examples inspired by this [book](http://www.amazon.com/Lattice-Multivariate-Data-Visualization-Use/dp/0387759689/ref=cm_cr_pr_product_top)


    ### ggplot2

    examples inspired by this [book](http://www.amazon.com/ggplot2-Elegant-Graphics-Data-Analysis/dp/0387981403/ref=sr_1_1?ie=UTF8&qid=1423697224&sr=8-1&keywords=ggplot2)
    0 examples.R → examples_ggplot2.R
    View file
    File renamed without changes.
    44 changes: 44 additions & 0 deletions examples_lattice.R
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,44 @@
    library(rbokeh)

    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
    library(dplyr)
    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
    library(dplyr)
    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)
    )
    }
    ) %>%
    grid_plot( nrow = 2, ncol = 3, same_axes=T )
  25. timelyportfolio revised this gist Feb 11, 2015. 1 changed file with 3 additions and 2 deletions.
    5 changes: 3 additions & 2 deletions examples.R
    View file
    Original file line number Diff line number Diff line change
    @@ -1,4 +1,5 @@
    # examples from ggplot2 book
    data(diamonds, package = "ggplot2")

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

    @@ -20,9 +21,9 @@ lapply(
    grid_plot( nrow = 3, ncol = 3, same_axes = T )

    # histogram on diamonds
    bp %>% ly_hist( x = "carat", data = diamonds, breaks = 2 )
    bp %>% ly_hist( x = carat, data = diamonds, breaks = 2 )
    # density on diamonds
    bp %>% ly_density( x = "carat", data = diamonds )
    bp %>% ly_density( x = carat, data = diamonds )
    # quantile on diamonds
    bp %>% ly_quantile(price,group = "color", diamonds)
    bp %>% ly_quantile(price,group = "color", diamonds, distn=qnorm)
  26. timelyportfolio revised this gist Feb 11, 2015. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion examples.R
    View file
    Original file line number Diff line number Diff line change
    @@ -40,7 +40,7 @@ bp %>%
    bp %>%
    ly_points( mpg, wt, mtcars, color = "purple")
    bp %>%
    ly_points( mpg, wt, mtcars, color = cyl )
    ly_points( mpg, wt, data.frame(name=rownames(mtcars),mtcars), color = cyl, hover = list(name))



  27. timelyportfolio revised this gist Feb 11, 2015. 1 changed file with 1 addition and 0 deletions.
    1 change: 1 addition & 0 deletions examples.R
    View file
    Original file line number Diff line number Diff line change
    @@ -25,6 +25,7 @@ bp %>% ly_hist( x = "carat", data = diamonds, breaks = 2 )
    bp %>% ly_density( x = "carat", data = diamonds )
    # quantile on diamonds
    bp %>% ly_quantile(price,group = "color", diamonds)
    bp %>% ly_quantile(price,group = "color", diamonds, distn=qnorm)

    #demo a transform
    bp %>%
  28. timelyportfolio created this gist Feb 11, 2015.
    52 changes: 52 additions & 0 deletions examples.R
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,52 @@
    # examples from ggplot2 book

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

    bp %>% ly_points(carat,price,diamonds,color=cut,size=5)
    # add hover
    bp %>%
    ly_points(carat,price,diamonds,color=cut,size=1,hover=list(cut,clarity,color))
    # make it a hexbin
    bp %>%
    ly_hexbin( carat, price, diamonds )
    # make it a hexbin with facet by color
    lapply(
    levels(unique(diamonds$color))
    ,function(c){
    figure( height = 300, width = 300, title = paste0("Color: ",c) ) %>%
    ly_hexbin( carat, price, diamonds[which(diamonds$color==c),] )
    }
    ) %>%
    grid_plot( nrow = 3, ncol = 3, same_axes = T )

    # histogram on diamonds
    bp %>% ly_hist( x = "carat", data = diamonds, breaks = 2 )
    # density on diamonds
    bp %>% ly_density( x = "carat", data = diamonds )
    # quantile on diamonds
    bp %>% ly_quantile(price,group = "color", diamonds)

    #demo a transform
    bp %>%
    ly_points( cyl, mpg^2, mtcars ) %>%
    # not transformed
    ly_points( cyl, mpg, mtcars, color = "red" ) %>%
    # axis need to come after layers specified
    y_axis( log = T )


    # set vs map color
    bp %>%
    ly_points( mpg, wt, mtcars, color = "purple")
    bp %>%
    ly_points( mpg, wt, mtcars, color = cyl )




    # boxplot
    data("Oxboys", package = "nlme")
    bp %>%
    ly_boxplot( Occasion, height, Oxboys )