diff --git a/DESCRIPTION b/DESCRIPTION index c8e5687..230e9ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,9 @@ Package: ggalt -Title: Extra Geoms, Stats and Coords for 'ggplot2' -Version: 0.0.2.9004 +Title: Alternate/Extra 'Geoms', 'Stats' and 'Coords' for 'ggplot2' +Version: 0.0.2.9005 Authors@R: c(person("Bob", "Rudis", email = "bob@rudis.net", role = c("aut", "cre"))) -Description: A package contains additional geoms, coords and stats for the revamped (late 2015) version of ggplot2. +Description: A package containing additional/alternate 'geoms', 'coords' and 'stats' + for use with the revamped (late 2015) version of ggplot2. Depends: R (>= 3.0.0), ggplot2 (>= 1.0.1.9003) License: AGPL + file LICENSE LazyData: true diff --git a/R/geom_bkde.r b/R/geom_bkde.r index 2915ed3..45526b1 100644 --- a/R/geom_bkde.r +++ b/R/geom_bkde.r @@ -36,7 +36,8 @@ geom_bkde <- function(mapping = NULL, data = NULL, stat = "bkde", position = position, show.legend = show.legend, inherit.aes = inherit.aes, - params = list(range.x=range.x, + params = list(bandwidth=bandwidth, + range.x=range.x, ...) ) } @@ -46,7 +47,7 @@ geom_bkde <- function(mapping = NULL, data = NULL, stat = "bkde", #' @usage NULL #' @export GeomBkde <- ggproto("GeomBkde", GeomArea, - default_aes = aes(colour = NA, fill = "grey20", size = 0.5, + default_aes = aes(colour = NA, fill = "gray20", size = 0.5, linetype = 1, alpha = NA) ) @@ -79,6 +80,12 @@ GeomBkde <- ggproto("GeomBkde", GeomArea, #' data(geyser, package="MASS") #' #' ggplot(geyser, aes(x=duration)) + +#' stat_bkde(alpha=1/2) +#' +#' ggplot(geyser, aes(x=duration)) + +#' geom_bkde(alpha=1/2) +#' +#' ggplot(geyser, aes(x=duration)) + #' stat_bkde(bandwidth=0.25) #' #' ggplot(geyser, aes(x=duration)) + @@ -117,13 +124,29 @@ StatBkde <- ggproto("StatBkde", Stat, required_aes = "x", - default_aes = aes(y = ..density.., fill = NA), + default_aes = aes(y = ..density.., colour = NA, fill = "gray20", size = 0.5, + linetype = 1, alpha = NA), compute_group = function(data, scales, kernel="normal", canonical=FALSE, bandwidth=NULL, gridsize=410, range.x=NULL, truncate=TRUE) { - if (is.null(bandwidth)) bandwidth <- KernSmooth::dpik(data$x) + # KernSmooth::dpik uses a generated normal distribution as part of it's + # operation but doesn't do this seed save/create/restore. When bandwidth + # is NULL the only way to produce consistency in calculated resuts is to use + # a dedicated random seed. This might be a candidate for parameterization. + + if (is.null(bandwidth)) { + tmp <- tempfile() + on.exit(unlink(tmp)) + save(".Random.seed", file=tmp) + set.seed(1492) + bandwidth <- KernSmooth::dpik(data$x) + message( + sprintf("Bandwidth not specified. Using '%3.2f', via KernSmooth::dpik.", + bandwidth)) + load(tmp) + } if (is.null(range.x)) range.x <- range(data$x) diff --git a/R/geom_bkde2d.r b/R/geom_bkde2d.r index d73b61a..e7f3e04 100644 --- a/R/geom_bkde2d.r +++ b/R/geom_bkde2d.r @@ -82,7 +82,7 @@ GeomBkde2d <- ggproto("GeomBkde2d", GeomPath, #' specified by range.x are ignored. see \code{\link[KernSmooth]{bkde2D}} #' for details #' @param contour If \code{TRUE}, contour the results of the 2d density -#' estimation +#' estimation #' @section Computed variables: #' Same as \code{\link{stat_contour}} #' @seealso \code{\link{geom_contour}} for contour drawing geom, @@ -127,18 +127,27 @@ StatBkde2d <- ggproto("StatBkde2d", Stat, grid_size=c(51, 51), range.x=NULL, truncate=TRUE) { + # See geom_bkde/stat_bkde if (is.null(bandwidth)) { + tmp <- tempfile() + on.exit(unlink(tmp)) + save(".Random.seed", file=tmp) + set.seed(1492) bandwidth <- c(KernSmooth::dpik(data$x), KernSmooth::dpik(data$y)) + message( + sprintf("Bandwidth not specified. Using ['%3.2f', '%3.2f'], via KernSmooth::dpik.", + bandwidth[1], bandwidth[2])) + load(tmp) } if (is.null(range.x)) { x_range <- range(data$x) y_range <- range(data$y) - x_range[1] <- x_range[1] - 1.5 * bandwidth[1] - x_range[2] <- x_range[2] + 1.5 * bandwidth[1] - y_range[1] <- y_range[1] - 1.5 * bandwidth[2] - y_range[2] <- y_range[2] + 1.5 * bandwidth[2] + x_range[1] <- x_range[1] - 1.75 * bandwidth[1] + x_range[2] <- x_range[2] + 1.75 * bandwidth[1] + y_range[1] <- y_range[1] - 1.75 * bandwidth[2] + y_range[2] <- y_range[2] + 1.75 * bandwidth[2] range.x <- list(x_range, y_range) } @@ -149,7 +158,10 @@ StatBkde2d <- ggproto("StatBkde2d", Stat, range.x, truncate ) - df <- data.frame(expand.grid(x = dens$x1, y = dens$x2), z = as.vector(dens$fhat)) + + df <- data.frame(expand.grid(x=dens$x1, + y=dens$x2), + z=as.vector(dens$fhat)) df$group <- data$group[1] if (contour) { @@ -160,5 +172,7 @@ StatBkde2d <- ggproto("StatBkde2d", Stat, df$piece <- 1 df } + } + ) diff --git a/README.Rmd b/README.Rmd index da906db..0158a42 100644 --- a/README.Rmd +++ b/README.Rmd @@ -37,6 +37,7 @@ The following functions are implemented: ### News +- Version 0.0.2.9005 released - cleanup before blog post - Version 0.0.2.9002 released - working 2D density plots - Version 0.0.2.9000 released @@ -110,11 +111,26 @@ ggplot(dat, aes(x, y, group=group, color=factor(group))) + data(geyser, package="MASS") ggplot(geyser, aes(x=duration)) + + stat_bkde(alpha=1/2) + +ggplot(geyser, aes(x=duration)) + + geom_bkde(alpha=1/2) + +ggplot(geyser, aes(x=duration)) + stat_bkde(bandwidth=0.25) ggplot(geyser, aes(x=duration)) + geom_bkde(bandwidth=0.25) +set.seed(1492) +dat <- data.frame(cond = factor(rep(c("A","B"), each=200)), + rating = c(rnorm(200),rnorm(200, mean=.8))) + +ggplot(dat, aes(x=rating, color=cond)) + geom_bkde(alpha=0) + +ggplot(dat, aes(x=rating, fill=cond)) + geom_bkde(alpha=0.3) + + # 2D KernSmooth::bkde2D plots are a WIP geyser_dat <- data.frame(x=geyser$duration, y=geyser$waiting) diff --git a/README.md b/README.md index 2f04a89..104a023 100644 --- a/README.md +++ b/README.md @@ -131,7 +131,8 @@ ggplot(dat, aes(x, y, group=group, color=factor(group))) + data(geyser, package="MASS") ggplot(geyser, aes(x=duration)) + - stat_bkde(bandwidth=0.25) + stat_bkde(alpha=1/2) +#> Bandwidth not specified. Using '0.14', via KernSmooth::dpik. ``` @@ -139,13 +140,53 @@ ggplot(geyser, aes(x=duration)) + ``` r ggplot(geyser, aes(x=duration)) + - geom_bkde(bandwidth=0.25) + geom_bkde(alpha=1/2) +#> Bandwidth not specified. Using '0.14', via KernSmooth::dpik. ``` ``` r +ggplot(geyser, aes(x=duration)) + + stat_bkde(bandwidth=0.25) +``` + + + +``` r + +ggplot(geyser, aes(x=duration)) + + geom_bkde(bandwidth=0.25) +``` + + + +``` r + +set.seed(1492) +dat <- data.frame(cond = factor(rep(c("A","B"), each=200)), + rating = c(rnorm(200),rnorm(200, mean=.8))) + +ggplot(dat, aes(x=rating, color=cond)) + geom_bkde(alpha=0) +#> Bandwidth not specified. Using '0.36', via KernSmooth::dpik. +#> Bandwidth not specified. Using '0.31', via KernSmooth::dpik. +``` + + + +``` r + +ggplot(dat, aes(x=rating, fill=cond)) + geom_bkde(alpha=0.3) +#> Bandwidth not specified. Using '0.36', via KernSmooth::dpik. +#> Bandwidth not specified. Using '0.31', via KernSmooth::dpik. +``` + + + +``` r + + # 2D KernSmooth::bkde2D plots are a WIP geyser_dat <- data.frame(x=geyser$duration, y=geyser$waiting) @@ -155,7 +196,7 @@ ggplot(geyser_dat, aes(x, y)) + geom_bkde2d(bandwidth=c(0.7, 7)) ``` - + ``` r @@ -164,7 +205,7 @@ ggplot(geyser_dat, aes(x, y)) + stat_bkde2d(bandwidth=c(0.7, 7)) ``` - + ### Test Results @@ -173,7 +214,7 @@ library(ggalt) library(testthat) date() -#> [1] "Tue Sep 8 21:44:34 2015" +#> [1] "Fri Sep 11 16:19:52 2015" test_dir("tests/") #> testthat results ======================================================================================================== diff --git a/README_figs/README-unnamed-chunk-4-10.png b/README_figs/README-unnamed-chunk-4-10.png index 4ec9f2d..68a82e1 100644 Binary files a/README_figs/README-unnamed-chunk-4-10.png and b/README_figs/README-unnamed-chunk-4-10.png differ diff --git a/README_figs/README-unnamed-chunk-4-11.png b/README_figs/README-unnamed-chunk-4-11.png index 6b14a99..ba9fe0c 100644 Binary files a/README_figs/README-unnamed-chunk-4-11.png and b/README_figs/README-unnamed-chunk-4-11.png differ diff --git a/README_figs/README-unnamed-chunk-4-12.png b/README_figs/README-unnamed-chunk-4-12.png index 6b14a99..ba9fe0c 100644 Binary files a/README_figs/README-unnamed-chunk-4-12.png and b/README_figs/README-unnamed-chunk-4-12.png differ diff --git a/README_figs/README-unnamed-chunk-4-13.png b/README_figs/README-unnamed-chunk-4-13.png new file mode 100644 index 0000000..c46a280 Binary files /dev/null and b/README_figs/README-unnamed-chunk-4-13.png differ diff --git a/README_figs/README-unnamed-chunk-4-14.png b/README_figs/README-unnamed-chunk-4-14.png new file mode 100644 index 0000000..57ec120 Binary files /dev/null and b/README_figs/README-unnamed-chunk-4-14.png differ diff --git a/README_figs/README-unnamed-chunk-4-15.png b/README_figs/README-unnamed-chunk-4-15.png new file mode 100644 index 0000000..6b14a99 Binary files /dev/null and b/README_figs/README-unnamed-chunk-4-15.png differ diff --git a/README_figs/README-unnamed-chunk-4-16.png b/README_figs/README-unnamed-chunk-4-16.png new file mode 100644 index 0000000..6b14a99 Binary files /dev/null and b/README_figs/README-unnamed-chunk-4-16.png differ diff --git a/README_figs/README-unnamed-chunk-4-9.png b/README_figs/README-unnamed-chunk-4-9.png index ba9fe0c..68a82e1 100644 Binary files a/README_figs/README-unnamed-chunk-4-9.png and b/README_figs/README-unnamed-chunk-4-9.png differ diff --git a/man/geom_bkde.Rd b/man/geom_bkde.Rd index 945a39f..ec98993 100644 --- a/man/geom_bkde.Rd +++ b/man/geom_bkde.Rd @@ -103,6 +103,12 @@ are in bold): data(geyser, package="MASS") ggplot(geyser, aes(x=duration)) + + stat_bkde(alpha=1/2) + +ggplot(geyser, aes(x=duration)) + + geom_bkde(alpha=1/2) + +ggplot(geyser, aes(x=duration)) + stat_bkde(bandwidth=0.25) ggplot(geyser, aes(x=duration)) +