diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..43c4d3a --- /dev/null +++ b/ChangeLog @@ -0,0 +1,6 @@ +Version 0.13.0 (2024-09-024) + * Add 'mode' parameter to 'relx' and 'rely'. + * Suggest 'qs2' instead of 'qs' + * Add 'light_cool_colors' theme +Version 0.12.0 (2023-04-06) + * Initial tracking diff --git a/DESCRIPTION b/DESCRIPTION index d1c8e63..75487c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: glow Title: Make Plots that Glow -Version: 0.12.0 -Date: 2023-4-6 +Version: 0.13.0 +Date: 2024-09-24 Authors@R: c( person("Travers", "Ching", email = "traversc@gmail.com", role = c("aut", "cre", "cph")) ) @@ -17,8 +17,8 @@ Imports: Depends: ggplot2 Suggests: - knitr, rmarkdown, viridisLite, magick, EBImage, qs + knitr, rmarkdown, viridisLite, magick, EBImage, qs2 VignetteBuilder: knitr -RoxygenNote: 7.1.2 +RoxygenNote: 7.3.2 URL: https://github.com/traversc/glow BugReports: https://github.com/traversc/glow/issues diff --git a/NAMESPACE b/NAMESPACE index f73772c..cdb731f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ importFrom(grDevices, col2rgb, rgb, colorRampPalette, rainbow) useDynLib(glow, .registration=TRUE) export("theme_night", "light_heat_colors", + "light_cool_colors", "additive_alpha", "GlowMapper", "GlowMapper4", diff --git a/R/glow_functions.r b/R/glow_pkg_functions.R similarity index 95% rename from R/glow_functions.r rename to R/glow_pkg_functions.R index 113de11..ba6b403 100644 --- a/R/glow_functions.r +++ b/R/glow_pkg_functions.R @@ -18,6 +18,10 @@ light_heat_colors <- function(...) { colorRampPalette(c("red", "darkorange2", "darkgoldenrod1", "gold1", "yellow2"))(...) } +light_cool_colors <- function(...) { + colorRampPalette(c("#1133AA", "#CCFFFF"))(...) +} + additive_alpha <- function(colors) { s <- seq(2, length(colors)) x <- t(col2rgb(colors, alpha=F))/255 @@ -44,14 +48,42 @@ map_colors <- function(colors, x, min_limit=NULL, max_limit=NULL) { colors[findInterval(x, seq(min_limit, max_limit, length.out = length(colors) + 1), all.inside = TRUE)] } -relx <- function(r) { - structure(r, class = "relx") +relx <- function(r, mode = "data") { + structure(r, class = "relx", mode = mode) } -rely <- function(r) { - structure(r, class = "rely") +rely <- function(r, mode = "data") { + structure(r, class = "rely", mode = mode) } +# internal helper function +calculate_radius <- function(radius, xdiff, ydiff, self) { + plot_x_diff <- self$xmax - self$xmin + plot_y_diff <- self$ymax - self$ymin + if(inherits(radius, "relx")) { + rel_mode <- attr(radius, "mode") + attributes(radius) <- NULL + if(rel_mode == "data") { + radius <- xdiff * radius / self$x_aspect_ratio + } else if(rel_mode == "plot") { + radius <- plot_x_diff * radius / self$x_aspect_ratio + } else { + stop("relx mode must be 'data' or 'plot'") + } + } else if(inherits(radius, "rely")) { + rel_mode <- attr(radius, "mode") + attributes(radius) <- NULL + if(rel_mode == "data") { + radius <- ydiff * radius / self$y_aspect_ratio + } else if(rel_mode == "plot") { + radius <- plot_y_diff * radius / self$y_aspect_ratio + } else { + stop("rely mode must be 'data' or 'plot'") + } + } else { + radius + } +} # GlowMapper ################################### GlowMapper <- R6Class("GlowMapper", list( @@ -115,16 +147,7 @@ GlowMapper <- R6Class("GlowMapper", list( self$x_aspect_ratio <- max(xincrement / yincrement,1) self$y_aspect_ratio <- max(yincrement / xincrement,1) - if(inherits(radius, "relx")) { - class(radius) <- NULL - radius <- xdiff * radius / self$x_aspect_ratio - } else if(inherits(radius, "rely")) { - class(radius) <- NULL - radius <- ydiff * radius / self$y_aspect_ratio - } else { - # nothing - } - class(radius) <- NULL + radius <- calculate_radius(radius, xdiff, ydiff, self) self$plot_data <- data.frame(x, y, intensity, radius, distance_exponent) @@ -275,17 +298,7 @@ GlowMapper4 <- R6Class("GlowMapper4", list( self$x_aspect_ratio <- max(xincrement / yincrement,1) self$y_aspect_ratio <- max(yincrement / xincrement,1) - - if(inherits(radius, "relx")) { - class(radius) <- NULL - radius <- xdiff * radius / self$x_aspect_ratio - } else if(inherits(radius, "rely")) { - class(radius) <- NULL - radius <- ydiff * radius / self$y_aspect_ratio - } else { - # nothing - } - class(radius) <- NULL + radius <- calculate_radius(radius, xdiff, ydiff, self) self$plot_data <- data.frame(x, y, r,g,b, radius, distance_exponent) @@ -460,16 +473,7 @@ LightMapper <- R6Class("LightMapper", list( self$x_aspect_ratio <- max(xincrement / yincrement,1) self$y_aspect_ratio <- max(yincrement / xincrement,1) - if(inherits(radius, "relx")) { - class(radius) <- NULL - radius <- xdiff * radius / self$x_aspect_ratio - } else if(inherits(radius, "rely")) { - class(radius) <- NULL - radius <- ydiff * radius / self$y_aspect_ratio - } else { - # nothing - } - class(radius) <- NULL + radius <- calculate_radius(radius, xdiff, ydiff, self) self$plot_data <- data.frame(x, y, intensity, radius, falloff_exponent, distance_exponent) @@ -615,16 +619,7 @@ LightMapper4 <- R6Class("GlowMapper4", list( self$x_aspect_ratio <- max(xincrement / yincrement,1) self$y_aspect_ratio <- max(yincrement / xincrement,1) - if(inherits(radius, "relx")) { - class(radius) <- NULL - radius <- xdiff * radius / self$x_aspect_ratio - } else if(inherits(radius, "rely")) { - class(radius) <- NULL - radius <- ydiff * radius / self$y_aspect_ratio - } else { - # nothing - } - class(radius) <- NULL + radius <- calculate_radius(radius, xdiff, ydiff, self) self$plot_data <- data.frame(x, y, r,g,b, radius, distance_exponent, falloff_exponent) diff --git a/R/zz_help_files.R b/R/zz_help_files.R index 56b9be9..50a7f6f 100644 --- a/R/zz_help_files.R +++ b/R/zz_help_files.R @@ -35,6 +35,25 @@ NULL #' @name light_heat_colors NULL +# light_cool_colors ################################################### + +#' light_cool_colors +#' +#' A light color palette. +#' +#' @usage light_cool_colors(...) +#' @param ... Arguments passed to the function returned by `colorRampPalette` +#' @return A light color palette function +#' @details A simple light color palette gradient from dark blue to light blue +#' intended for a heatmap with a white or light color background. +#' +#' Equivalent to `colorRampPalette(c("#1133AA", "#CCFFFF"))(...)`. +#' @examples +#' light_colors <- light_cool_colors(144) +#' plot(1:144, 1:144, col = light_colors, pch = 19) +#' @name light_cool_colors +NULL + # circular_palette ################################################### #' circular_palette @@ -94,9 +113,11 @@ NULL #' #' Helper functions for specifying the `radius` parameter in `GlowMapper$map` and similar. #' -#' @usage relx(r) -#' @aliases relx -#' @param r Radius of point data relative to X or Y range of the plot, a value between 0 and 1. +#' @usage relx(r, mode = "data") +#' @usage rely(r, mode = "data") +#' @param r Radius of point data relative to X or Y range of the plot, a value between 0 and 1. +#' @param mode One of "data" (default) or "plot". Whether to use a radius relative to the extent +#' of the data range or the plot range (which could have been adjusted manually). #' @return A class structure for input to `GlowMapper$map` #' @details #' Helper functions for specifying the `radius` parameter relative to the range of the plot as a proportion. @@ -126,7 +147,10 @@ NULL #' @name relxy NULL -#' @usage rely(r) +#' @aliases relx +#' @name relxy +NULL + #' @aliases rely #' @name relxy NULL diff --git a/README.md b/README.md index 0e05097..b94eb58 100644 --- a/README.md +++ b/README.md @@ -95,7 +95,7 @@ ggplot() + ![](vignettes/diamonds_vignette_dark.png "diamonds_vignette_dark.png") ``` r -# light color theme +# light "heat" color theme light_colors <- light_heat_colors(144) ggplot() + geom_raster(data = pd, aes(x = pd$x, y = pd$y, fill = pd$value), show.legend = FALSE) + @@ -107,6 +107,19 @@ ggplot() + ![](vignettes/diamonds_vignette_light.png "diamonds_vignette_light.png") +``` r +# light "cool" color theme +light_colors <- light_cool_colors(144) +ggplot() + + geom_raster(data = pd, aes(x = pd$x, y = pd$y, fill = pd$value), show.legend = FALSE) + + scale_fill_gradientn(colors = additive_alpha(light_colors)) + + coord_fixed(gm$aspect(), xlim = gm$xlim(), ylim = gm$ylim()) + + labs(x = "carat", y = "price") + + theme_bw(base_size = 14) +``` + +![](vignettes/diamonds_vignette_cool.png "diamonds_vignette_cool.png") + ### Writing a raster image directly Instead of using ggplot, you can also output a raster image directly diff --git a/inst/examples/examples.R b/inst/examples/examples.R index 0bb7286..18c6f6f 100755 --- a/inst/examples/examples.R +++ b/inst/examples/examples.R @@ -13,7 +13,7 @@ library(dplyr) library(data.table) -library(qs) +library(qs2) library(glow) library(ggplot2) @@ -59,7 +59,7 @@ output_width = 1920*4 output_height = 1080*4 outfile <- "plots/GAIA_galaxy_pseudocolor.png" -stars <- qread("plot_data/gaia_stars.qs") +stars <- qs_read("plot_data/gaia_stars.qs2") # Transform to galactic coordinates # https://gea.esac.esa.int/archive/documentation/GDR2/Data_processing/chap_cu3ast/sec_cu3ast_intro/ssec_cu3ast_intro_tansforms.html @@ -116,7 +116,7 @@ writeImage(img, "plots/GAIA_galaxy_pseudocolor.png") outfile <- "plots/US_coronavirus_2021.png" -cov_cases <- qread("plot_data/covid_confirmed_usafacts.qs") +cov_cases <- qs_read("plot_data/covid_confirmed_usafacts.qs2") centroids <- cov_cases$centroids state <- cov_cases$state county <- cov_cases$county @@ -280,9 +280,23 @@ outfile <- "plots/diamonds_vignette_light.png" ggsave(g, file=outfile, width=10, height=4, dpi=96) trim_image(outfile, "white") +# light color theme with cool colors +light_colors <- colorRampPalette(c("#1133AA", "#CCFFFF"))(144) +g <- ggplot() + + geom_raster(data = pd, aes(x = pd$x, y = pd$y, fill = pd$value), show.legend = F) + + scale_fill_gradientn(colors = additive_alpha(light_colors)) + + coord_fixed(gm$aspect(), xlim = gm$xlim(), ylim = gm$ylim()) + + labs(x = "carat", y = "price") + + theme_bw(base_size = 14) + +outfile <- "plots/diamonds_vignette_cool.png" +ggsave(g, file=outfile, width=10, height=4, dpi=96) +trim_image(outfile, "white") + + # Volcano ########################################## -DMPs <- qread("plot_data/methylation_data.qs") +DMPs <- qs_read("plot_data/methylation_data.qs2") adj_pval_threshold <- DMPs %>% filter(adj.P.Val < 0.05) %>% pull(P.Value) %>% max @@ -308,7 +322,7 @@ trim_image(outfile, "white") # https://www.r-bloggers.com/visualize-large-data-sets-with-the-bigvis-package/ ## wget https://packages.revolutionanalytics.com/datasets/AirOnTime87to12/AirOnTimeCSV.zip . -air <- qread("plot_data/AirOnTime.qs", nthreads=nt) +air <- qs_read("plot_data/AirOnTime.qs2", nthreads=nt) temp <- rbindlist(air) qlo1 <- temp$ARR_DELAY %>% quantile(0.0025) diff --git a/inst/examples/examples_parse_data.R b/inst/examples/examples_parse_data.R index b547d38..9e04efd 100755 --- a/inst/examples/examples_parse_data.R +++ b/inst/examples/examples_parse_data.R @@ -4,7 +4,7 @@ library(glow) library(dplyr) library(data.table) library(arrow) -library(qs) +library(qs2) library(stringr) # COVID example @@ -41,7 +41,7 @@ stars <- lapply(files, function(f) { stars2 <- stars[complete.cases(stars),] stars2 <- stars2 %>% arrange_all -qsave(stars2, "plot_data/gaia_stars.qs", preset = "custom", algorithm = "zstd", compress_level = 22, nthreads = 8) +qs_save(stars2, "plot_data/gaia_stars.qs2", preset = "custom", algorithm = "zstd", compress_level = 22, nthreads = 8) # COVID ####################################################################### @@ -61,7 +61,7 @@ centroids <- left_join(centroids, cov_cases, by = c("name", "state_abbr")) centroids$total[is.na(centroids$total)] <- 0 centroids <- filter(centroids, total > 0) -qsave(list(centroids=centroids, county=county, state=state), "plot_data/covid_confirmed_usafacts.qs", preset = "custom", algorithm = "zstd", compress_level = 22) +qs_save(list(centroids=centroids, county=county, state=state), "plot_data/covid_confirmed_usafacts.qs2", preset = "custom", algorithm = "zstd", compress_level = 22) # Volcano ########################################## @@ -102,7 +102,7 @@ DMPs <- topTable(fit2, num=Inf, coef=1, genelist=ann450kSub) DMPs <- DMPs %>% dplyr::select(logFC, P.Value, adj.P.Val) rownames(DMPs) <- NULL -qsave(DMPs, file = "plot_data/methylation_data.qs", preset = "custom", algorithm = "zstd", compress_level = 22) +qs_save(DMPs, file = "plot_data/methylation_data.qs2", preset = "custom", algorithm = "zstd", compress_level = 22) # Airline ###################################################################### # https://www.r-bloggers.com/visualize-large-data-sets-with-the-bigvis-package/ @@ -119,7 +119,7 @@ air <- lapply(1:length(files), function(i) { filter(complete.cases(.)) return(z) }) -qsave(air, file="plot_data/AirOnTime.qs", preset = "custom", algorithm = "zstd", compress_level = 22, nthreads=nt) +qs_save(air, file="plot_data/AirOnTime.qs2", preset = "custom", algorithm = "zstd", compress_level = 22, nthreads=nt) # GPS traces ###################################################################### # https://planet.osm.org/gps/ @@ -130,6 +130,6 @@ system(sprintf("unxz %s/simple-gps-points-120312.txt.xz", tempdir)) gps <- data.table::fread(sprintf("%s/simple-gps-points-120312.txt", tempdir), header=FALSE, data.table=FALSE) gps <- list(latitude = gps[[1]], longitude = gps[[2]]) # Long dataframes not supported in R as of 4.2.3 -qsave(gps, file="plot_data/simple-gps-points.qs", preset = "custom", algorithm = "zstd", compress_level = 22, nthreads=nt) +qs_save(gps, file="plot_data/simple-gps-points.qs2", preset = "custom", algorithm = "zstd", compress_level = 22, nthreads=nt) diff --git a/inst/examples/gps_example.R b/inst/examples/gps_example.R index b4dc220..3023483 100644 --- a/inst/examples/gps_example.R +++ b/inst/examples/gps_example.R @@ -1,4 +1,4 @@ -library(qs) +library(qs2) library(glow) library(EBImage) @@ -10,7 +10,7 @@ output_height = 1080*4 radius <- 0.2 # Increase this value if plotting fewer points intensity <- 0.6 # Increase this value if plotting fewer points -gps <- qread("plot_data/simple-gps-points.qs", nthreads=32) +gps <- qs_read("plot_data/simple-gps-points.qs2", nthreads=32) length(gps$latitude) # 2770233904 diff --git a/man/light_cool_colors.Rd b/man/light_cool_colors.Rd new file mode 100644 index 0000000..e818a8b --- /dev/null +++ b/man/light_cool_colors.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/zz_help_files.R +\name{light_cool_colors} +\alias{light_cool_colors} +\title{light_cool_colors} +\usage{ +light_cool_colors(...) +} +\arguments{ +\item{...}{Arguments passed to the function returned by `colorRampPalette`} +} +\value{ +A light color palette function +} +\description{ +A light color palette. +} +\details{ +A simple light color palette gradient from dark blue to light blue +intended for a heatmap with a white or light color background. + + Equivalent to `colorRampPalette(c("#1133AA", "#CCFFFF"))(...)`. +} +\examples{ +light_colors <- light_cool_colors(144) +plot(1:144, 1:144, col = light_colors, pch = 19) +} diff --git a/man/relxy.Rd b/man/relxy.Rd index 3f6564d..2910ec8 100644 --- a/man/relxy.Rd +++ b/man/relxy.Rd @@ -6,12 +6,15 @@ \alias{rely} \title{relxy} \usage{ -relx(r) +relx(r, mode = "data") -rely(r) +rely(r, mode = "data") } \arguments{ \item{r}{Radius of point data relative to X or Y range of the plot, a value between 0 and 1.} + +\item{mode}{One of "data" (default) or "plot". Whether to use a radius relative to the extent +of the data range or the plot range (which could have been adjusted manually).} } \value{ A class structure for input to `GlowMapper$map` diff --git a/vignettes/diamonds_vignette_cool.png b/vignettes/diamonds_vignette_cool.png new file mode 100755 index 0000000..621cb84 Binary files /dev/null and b/vignettes/diamonds_vignette_cool.png differ diff --git a/vignettes/vignette.html b/vignettes/vignette.html index e833103..ef75e17 100644 --- a/vignettes/vignette.html +++ b/vignettes/vignette.html @@ -14,6 +14,35 @@ glow + +