scattermore/0000755000176200001440000000000014441553612012607 5ustar liggesusersscattermore/NAMESPACE0000644000176200001440000000202514441403173014021 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(apply_kernel_histogram) export(apply_kernel_rgbwt) export(blend_rgba_float) export(geom_scattermore) export(geom_scattermost) export(histogram_to_rgbwt) export(merge_rgbwt) export(rgba_float_to_rgba_int) export(rgba_int_to_raster) export(rgbwt_to_rgba_float) export(rgbwt_to_rgba_int) export(scatter_lines_histogram) export(scatter_lines_rgbwt) export(scatter_points_histogram) export(scatter_points_rgbwt) export(scattermore) export(scattermoreplot) importFrom(ggplot2,.data) importFrom(ggplot2,Geom) importFrom(ggplot2,aes) importFrom(ggplot2,draw_key_point) importFrom(ggplot2,ggproto) importFrom(ggplot2,layer) importFrom(grDevices,as.raster) importFrom(grDevices,col2rgb) importFrom(grDevices,dev.size) importFrom(grDevices,hcl.colors) importFrom(grDevices,rgb) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,rasterImage) importFrom(grid,rasterGrob) importFrom(scales,alpha) useDynLib(scattermore, .registration = TRUE) useDynLib(scattermore, .registration=TRUE) scattermore/man/0000755000176200001440000000000014441403173013356 5ustar liggesusersscattermore/man/apply_kernel_histogram.Rd0000644000176200001440000000224414441403173020411 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/apply_kernel_histogram.R \name{apply_kernel_histogram} \alias{apply_kernel_histogram} \title{apply_kernel_histogram} \usage{ apply_kernel_histogram( fhistogram, filter = "circle", mask = default_kernel(filter, radius, sigma), radius = 2, sigma = radius/2, threads = 0 ) } \arguments{ \item{fhistogram}{Matrix or array interpreted as histogram of floating-point values.} \item{filter}{Use the pre-defined filter, either \code{circle}, \code{square}, \code{gauss}. Defaults to \code{circle}.} \item{mask}{Custom kernel used for blurring, overrides \code{filter}. Must be a square matrix of odd size.} \item{radius}{Radius of the kernel (counted without the "middle" pixel"), defaults to 2. The generated kernel matrix will be a square with (2*radius+1) pixels on each side.} \item{sigma}{Radius of the Gaussian function selected by \code{filter}, defaults to \code{radius/2}.} \item{threads}{Number of parallel threads (default 0 chooses hardware concurrency).} } \value{ 2D matrix with the histogram processed by the kernel application. } \description{ Apply a kernel to the given histogram. } scattermore/man/rgbwt_to_rgba_float.Rd0000644000176200001440000000065514441403173017662 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rgbwt_to_rgba_float.R \name{rgbwt_to_rgba_float} \alias{rgbwt_to_rgba_float} \title{rgbwt_to_rgba_float} \usage{ rgbwt_to_rgba_float(fRGBWT) } \arguments{ \item{fRGBWT}{The RGBWT matrix.} } \value{ RGBA matrix, output \emph{is premultiplied} by alpha. } \description{ Convert RGBWT matrix to floating-point RGBA matrix, suitable for alpha-blending. } scattermore/man/scatter_lines_rgbwt.Rd0000644000176200001440000000262614441403173017717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scatter_lines_rgbwt.R \name{scatter_lines_rgbwt} \alias{scatter_lines_rgbwt} \title{scatter_lines_rgbwt} \usage{ scatter_lines_rgbwt( xy, xlim = c(min(xy[, c(1, 3)]), max(xy[, c(1, 3)])), ylim = c(min(xy[, c(2, 4)]), max(xy[, c(2, 4)])), out_size = c(512L, 512L), RGBA = c(0, 0, 0, 255), skip_start_pixel = FALSE, skip_end_pixel = TRUE ) } \arguments{ \item{xy}{4-column matrix with point coordinates. Each row contains X and Y coordinates of line start and X and Y coordinates of line end, in this order.} \item{xlim, ylim}{2-element vector of rendered area limits (position of the first pixel on the left/top, and the last pixel on the right/bottom). You can flip the image coordinate system by flipping the \verb{*lim} vectors.} \item{out_size}{2-element vector size of the result raster, defaults to \code{c(512L,512L)}.} \item{RGBA}{Vector of 4 elements with integral RGBA color for the lines, defaults to \code{c(0,0,0,255)}.} \item{skip_start_pixel}{TRUE if the start pixel of the lines should be omitted, defaults to \code{FALSE}.} \item{skip_end_pixel}{TRUE if the end pixel of a line should be omitted, defaults to \code{TRUE}. (When plotting long ribbons of connected lines, this prevents counting the connecting pixels twice.)} } \value{ Lines plotted in RGBWT bitmap. } \description{ Render lines into a RGBWT bitmap. } scattermore/man/scattermore.Rd0000644000176200001440000000271214441403173016177 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scattermore.R \name{scattermore} \alias{scattermore} \title{scattermore} \usage{ scattermore( xy, size = c(512, 512), xlim = c(min(xy[, 1]), max(xy[, 1])), ylim = c(min(xy[, 2]), max(xy[, 2])), rgba = c(0L, 0L, 0L, 255L), cex = 0, output.raster = TRUE ) } \arguments{ \item{xy}{2-column float matrix with point coordinates. As usual with rasters in R, X axis grows right, and Y axis grows DOWN. Flipping \code{ylim} causes the usual mathematical behavior.} \item{size}{2-element vector integer size of the result raster, defaults to \code{c(512,512)}.} \item{xlim, ylim}{Float limits as usual (position of the first pixel on the left/top, and the last pixel on the right/bottom). You can easily flip the top/bottom to the "usual" mathematical system by flipping the \code{ylim} vector.} \item{rgba}{4-row matrix with color values of 0-255, or just a single 4-item vector for \code{c(r,g,b,a)}. Best created with \code{col2rgb(..., alpha=TRUE)}.} \item{cex}{Additional point radius in pixels, 0=single-pixel dots (fastest)} \item{output.raster}{Output R-style raster (as.raster)? Default TRUE. Raw array output can be used much faster, e.g. for use with png::writePNG.} } \value{ Raster with the result. } \description{ Convert points to raster scatterplot rather quickly. } \examples{ library(scattermore) plot(scattermore(cbind(rnorm(1e6), rnorm(1e6)), rgba = c(64, 128, 192, 10))) } scattermore/man/scatter_lines_histogram.Rd0000644000176200001440000000244514441403173020566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scatter_lines_histogram.R \name{scatter_lines_histogram} \alias{scatter_lines_histogram} \title{scatter_lines_histogram} \usage{ scatter_lines_histogram( xy, xlim = c(min(xy[, c(1, 3)]), max(xy[, c(1, 3)])), ylim = c(min(xy[, c(2, 4)]), max(xy[, c(2, 4)])), out_size = c(512L, 512L), skip_start_pixel = FALSE, skip_end_pixel = TRUE ) } \arguments{ \item{xy}{4-column matrix with point coordinates. Each row contains X and Y coordinates of line start and X and Y coordinates of line end, in this order.} \item{xlim, ylim}{2-element vector of rendered area limits (position of the first pixel on the left/top, and the last pixel on the right/bottom). You can flip the image coordinate system by flipping the \verb{*lim} vectors.} \item{out_size}{2-element vector size of the result raster, defaults to \code{c(512L,512L)}.} \item{skip_start_pixel}{TRUE if the start pixel of the lines should be omitted, defaults to \code{FALSE}.} \item{skip_end_pixel}{TRUE if the end pixel of a line should be omitted, defaults to \code{TRUE}. (When plotting long ribbons of connected lines, this prevents counting the connecting pixels twice.)} } \value{ Histogram with the rendered lines. } \description{ Render lines into a histogram. } scattermore/man/geom_scattermost.Rd0000644000176200001440000000255114441403173017227 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scattermore.R \name{geom_scattermost} \alias{geom_scattermost} \title{geom_scattermost} \usage{ geom_scattermost( xy, color = "black", interpolate = FALSE, pointsize = 0, pixels = c(512, 512) ) } \arguments{ \item{xy}{2-column object with data, as in \code{\link[=scattermore]{scattermore()}}.} \item{color}{Color vector (or a single color).} \item{interpolate}{Default FALSE, passed to \code{\link[grid:grid.raster]{grid::rasterGrob()}}.} \item{pointsize}{Radius of rasterized point. Use \code{0} for single pixels (fastest).} \item{pixels}{Vector with X and Y resolution of the raster, default \code{c(512,512)}.} } \description{ Totally non-ggplotish version of \code{\link[=geom_scattermore]{geom_scattermore()}}, but faster. It avoids most of the ggplot processing by bypassing the largest portion of data around any ggplot functionality, leaving only enough data to set up axes and limits correctly. If you need to break speed records, use this. } \examples{ library(ggplot2) library(scattermore) d <- data.frame(x = rnorm(1000000), y = rnorm(1000000)) x_rng <- range(d$x) ggplot() + geom_scattermost(cbind(d$x, d$y), color = heat.colors(100, alpha = .01) [1 + 99 * (d$x - x_rng[1]) / diff(x_rng)], pointsize = 2.5, pixels = c(1000, 1000), interpolate = TRUE ) } scattermore/man/GeomScattermost.Rd0000644000176200001440000000063014441403173016764 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scattermore.R \docType{data} \name{GeomScattermost} \alias{GeomScattermost} \title{The actual geom for scattermost} \format{ An object of class \code{GeomScattermost} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 4. } \usage{ GeomScattermost } \description{ The actual geom for scattermost } \keyword{datasets} scattermore/man/merge_rgbwt.Rd0000644000176200001440000000065614441403173016160 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/merge_rgbwt.R \name{merge_rgbwt} \alias{merge_rgbwt} \title{merge_rgbwt} \usage{ merge_rgbwt(fRGBWT_list) } \arguments{ \item{fRGBWT_list}{List of RGBWT arrays. The order of the matrices does not matter (except for negligible floating-point rounding and other robustness errors).} } \value{ Merged RGBWT matrix. } \description{ Merge RGBWT matrices. } scattermore/man/scattermoreplot.Rd0000644000176200001440000000242214441403173017074 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scattermore.R \name{scattermoreplot} \alias{scattermoreplot} \title{scattermoreplot} \usage{ scattermoreplot( x, y, xlim, ylim, size, col = grDevices::rgb(0, 0, 0, 1), cex = 0, pch = NULL, xlab, ylab, ... ) } \arguments{ \item{x, y, xlim, ylim, xlab, ylab, ...}{used as in \code{\link[graphics:plot.default]{graphics::plot()}} or forwarded to \code{\link[graphics:plot.default]{graphics::plot()}}} \item{size}{forwarded to \code{\link[=scattermore]{scattermore()}}, or auto-derived from device and plot size if missing (the estimate is not pixel-perfect on most devices, but gets pretty close)} \item{col}{point color(s)} \item{cex}{forwarded to \code{\link[=scattermore]{scattermore()}}} \item{pch}{ignored (to improve compatibility with \code{\link[graphics:plot.default]{graphics::plot()}}} } \description{ Convenience base-graphics-like layer around scattermore. Currently only works with linear axes! } \examples{ # plot an actual rainbow library(scattermore) d <- data.frame(s = qlogis(1:1e6 / (1e6 + 1), 6, 0.5), t = rnorm(1e6, pi / 2, 0.5)) scattermoreplot( d$s * cos(d$t), d$s * sin(d$t), col = rainbow(1e6, alpha = .05)[c((9e5 + 1):1e6, 1:9e5)], main = "scattermore demo" ) } scattermore/man/histogram_to_rgbwt.Rd0000644000176200001440000000132614441403173017553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/histogram_to_rgbwt.R \name{histogram_to_rgbwt} \alias{histogram_to_rgbwt} \title{histogram_to_rgbwt} \usage{ histogram_to_rgbwt( fhistogram, RGBA = grDevices::col2rgb(col, alpha = T), col = grDevices::hcl.colors(10), zlim = c(min(fhistogram), max(fhistogram)) ) } \arguments{ \item{fhistogram}{Matrix or 2D array with the histogram of values.} \item{RGBA}{4-by-N matrix floating-point R, G, B and A channels for the palette. Overrides \code{col}.} \item{col}{Colors to use for coloring.} \item{zlim}{Values to use as extreme values of the histogram} } \value{ RGBWT matrix. } \description{ Colorize given histogram with input palette. } scattermore/man/GeomScattermore.Rd0000644000176200001440000000063014441403173016744 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scattermore.R \docType{data} \name{GeomScattermore} \alias{GeomScattermore} \title{The actual geom for scattermore} \format{ An object of class \code{GeomScattermore} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 6. } \usage{ GeomScattermore } \description{ The actual geom for scattermore } \keyword{datasets} scattermore/man/rgba_float_to_rgba_int.Rd0000644000176200001440000000071714441403173020321 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rgba_float_to_rgba_int.R \name{rgba_float_to_rgba_int} \alias{rgba_float_to_rgba_int} \title{rgba_float_to_rgba_int} \usage{ rgba_float_to_rgba_int(fRGBA) } \arguments{ \item{fRGBA}{RGBA bitmap in N-by-M-by-4 array.} } \value{ RGBA matrix. The output \emph{is not premultiplied} by alpha. } \description{ Convert a float RGBA bitmap with pre-multiplied alpha to integer RGBA bitmap. } scattermore/man/blend_rgba_float.Rd0000644000176200001440000000074214441403173017114 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/blend_rgba_float.R \name{blend_rgba_float} \alias{blend_rgba_float} \title{blend_rgba_float} \usage{ blend_rgba_float(fRGBA_list) } \arguments{ \item{fRGBA_list}{List of floating-point RGBA arrays with premultiplied alpha (each of the same size N-by-M-by-4). The "first" matrix in the list is the one that will be rendered on "top".} } \value{ Blended RGBA matrix. } \description{ Blend RGBA matrices. } scattermore/man/scatter_points_histogram.Rd0000644000176200001440000000155614441403173020772 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scatter_points_histogram.R \name{scatter_points_histogram} \alias{scatter_points_histogram} \title{scatter_points_histogram} \usage{ scatter_points_histogram( xy, xlim = c(min(xy[, 1]), max(xy[, 1])), ylim = c(min(xy[, 2]), max(xy[, 2])), out_size = c(512L, 512L) ) } \arguments{ \item{xy}{2-column matrix with point coordinates (X and Y).} \item{xlim, ylim}{2-element vector of rendered area limits (position of the first pixel on the left/top, and the last pixel on the right/bottom). You can flip the image coordinate system by flipping the \verb{*lim} vectors.} \item{out_size}{2-element vector size of the result raster, defaults to \code{c(512L,512L)}.} } \value{ 2D histogram with the points "counted" in appropriate pixels. } \description{ Render a 2D histogram with given points } scattermore/man/scatter_points_rgbwt.Rd0000644000176200001440000000273714441403173020124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scatter_points_rgbwt.R \name{scatter_points_rgbwt} \alias{scatter_points_rgbwt} \title{scatter_points_rgbwt} \usage{ scatter_points_rgbwt( xy, xlim = c(min(xy[, 1]), max(xy[, 1])), ylim = c(min(xy[, 2]), max(xy[, 2])), out_size = c(512, 512), RGBA = c(0, 0, 0, 255), map = NULL, palette = NULL ) } \arguments{ \item{xy}{2-column matrix with N point coordinates (X and Y) in rows.} \item{xlim, ylim}{2-element vector of rendered area limits (position of the first pixel on the left/top, and the last pixel on the right/bottom). You can flip the image coordinate system by flipping the \verb{*lim} vectors.} \item{out_size}{2-element vector size of the result raster, defaults to \code{c(512L,512L)}.} \item{RGBA}{Point colors. Either a 4-element vector that specifies the same color for all points, or 4-by-N matrix that specifies color for each of the individual points. Color is specified using integer RGBA; i.e. the default black is \code{c(0,0,0,255)}.} \item{map}{Vector with N integer indices to \code{palette}. Overrides RGBA-based coloring.} \item{palette}{Matrix 4-by-K matrix of RGBA colors used as a palette lookup for the \code{map} that gives the point colors. K is at least \code{max(map)}. Notably, using a palette may be faster than filling and processing the whole RGBA matrix.} } \value{ A RGBWT array with the rendered points. } \description{ Render colored points into a RGBWT bitmap } scattermore/man/rgbwt_to_rgba_int.Rd0000644000176200001440000000061614441403173017344 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rgbwt_to_rgba_int.R \name{rgbwt_to_rgba_int} \alias{rgbwt_to_rgba_int} \title{rgbwt_to_rgba_int} \usage{ rgbwt_to_rgba_int(fRGBWT) } \arguments{ \item{fRGBWT}{The RGBWT matrix.} } \value{ A RGBA matrix. The output \emph{is not premultiplied} by alpha. } \description{ Convert a RGBWT matrix to an integer RGBA matrix. } scattermore/man/geom_scattermore.Rd0000644000176200001440000000350414441403173017206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scattermore.R \name{geom_scattermore} \alias{geom_scattermore} \title{geom_scattermore} \usage{ geom_scattermore( mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, interpolate = FALSE, pointsize = 0, pixels = c(512, 512) ) } \arguments{ \item{mapping, data, stat, position, inherit.aes, show.legend, ...}{passed to \code{\link[ggplot2:layer]{ggplot2::layer()}}} \item{na.rm}{Remove NA values, just as with \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}}.} \item{interpolate}{Default FALSE, passed to \code{\link[grid:grid.raster]{grid::rasterGrob()}}.} \item{pointsize}{Radius of rasterized point. Use \code{0} for single pixels (fastest).} \item{pixels}{Vector with X and Y resolution of the raster, default \code{c(512,512)}.} } \description{ \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} integration. This cooperates with the rest of ggplot (so you can use it to e.g. add rasterized scatterplots to vector output in order to reduce PDF size). Note that the ggplot processing overhead still dominates the plotting time. Use \code{\link[=geom_scattermost]{geom_scattermost()}} to tradeoff some niceness and circumvent ggplot logic to gain speed. } \details{ Accepts aesthetics \code{x}, \code{y}, \code{colour} and \code{alpha}. Point size is fixed for all points. Due to rasterization properties it is often beneficial to try non-integer point sizes, e.g. \code{3.2} looks much better than \code{3}. } \examples{ library(ggplot2) library(scattermore) ggplot(data.frame(x = rnorm(1e6), y = rexp(1e6))) + geom_scattermore(aes(x, y, color = x), pointsize = 3, alpha = 0.1, pixels = c(1000, 1000), interpolate = TRUE ) + scale_color_viridis_c() } scattermore/man/rgba_int_to_raster.Rd0000644000176200001440000000062614441403173017520 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rgba_int_to_raster.R \name{rgba_int_to_raster} \alias{rgba_int_to_raster} \title{rgba_int_to_raster} \usage{ rgba_int_to_raster(i32RGBA) } \arguments{ \item{i32RGBA}{Integer RGBA matrix (with all values between 0 and 255).} } \value{ The matrix converted to raster. } \description{ Create a raster from the given RGBA matrix. } scattermore/man/apply_kernel_rgbwt.Rd0000644000176200001440000000224714441403173017544 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/apply_kernel_rgbwt.R \name{apply_kernel_rgbwt} \alias{apply_kernel_rgbwt} \title{apply_kernel_rgbwt} \usage{ apply_kernel_rgbwt( fRGBWT, filter = "circle", mask = default_kernel(filter, radius, sigma), radius = 2, sigma = radius/2, threads = 0 ) } \arguments{ \item{fRGBWT}{RGBWT array with channels \code{red}, \code{green}, \code{blue}, \code{weight} and \code{transparency}. The dimension should be N times M times 5.} \item{filter}{Use the pre-defined filter, either \code{circle}, \code{square}, \code{gauss}. Defaults to \code{circle}.} \item{mask}{Custom kernel used for blurring, overrides \code{filter}. Must be a square matrix of odd size.} \item{radius}{Radius of the kernel (counted without the "middle" pixel"), defaults to 2. The generated kernel matrix will be a square with (2*radius+1) pixels on each side.} \item{sigma}{Radius of the Gaussian function selected by \code{filter}, defaults to \code{radius/2}.} \item{threads}{Number of parallel threads (default 0 chooses hardware concurrency).} } \value{ RGBWT matrix. } \description{ Apply a kernel to the given RGBWT raster. } scattermore/DESCRIPTION0000644000176200001440000000206414441553612014317 0ustar liggesusersPackage: scattermore Title: Scatterplots with More Points Version: 1.2 Authors@R: c(person(given = "Tereza", family = "Kulichova", role = c("aut"), email = "kulichova.t@gmail.com"), person(given = "Mirek", family = "Kratochvil", role = c("aut", "cre"), email = "exa.exa@gmail.com", comment = c(ORCID = "0000-0001-7356-4075"))) Description: C-based conversion of large scatterplot data to rasters plus other operations such as data blurring or data alpha blending. Speeds up plotting of data with millions of points. Imports: ggplot2, scales, grid, grDevices, graphics License: GPL (>= 3) Encoding: UTF-8 RoxygenNote: 7.2.3 Suggests: covr, knitr, rmarkdown, testthat VignetteBuilder: knitr NeedsCompilation: yes Packaged: 2023-06-11 17:47:59 UTC; exa Author: Tereza Kulichova [aut], Mirek Kratochvil [aut, cre] () Maintainer: Mirek Kratochvil Repository: CRAN Date/Publication: 2023-06-12 08:30:02 UTC scattermore/build/0000755000176200001440000000000014441404317013703 5ustar liggesusersscattermore/build/vignette.rds0000644000176200001440000000034114441404317016240 0ustar liggesusersm @4 $/uMIXX[O 37 {BF1cdb,04b e,Ls "A+m9ED%]en9 q8JnkXUdzGE1f^ʠ{N{=j~Ͽ%xv3ybpF꠳J&7,έscattermore/tests/0000755000176200001440000000000014441403173013745 5ustar liggesusersscattermore/tests/testthat/0000755000176200001440000000000014441553612015611 5ustar liggesusersscattermore/tests/testthat/test-geom-methods-basic.R0000644000176200001440000000106714441403173022360 0ustar liggesusers test_that("geom scattermore does not fail on trivial data", { d <- data.frame(x = rnorm(1e5), y = rnorm(1e5)) expect_silent(geom_scattermore( aes(d$x, d$y, color = d$x), pointsize = 3, alpha = 0.1, pixels = c(1000, 1000), interpolate = TRUE )) }) test_that("geom scattermost does not fail on trivial data", { d <- data.frame(x = rnorm(1e5), y = runif(1e5)) expect_silent(geom_scattermost( cbind(rnorm(1e6), runif(1e6)), col = rainbow(100, alpha = 0.05)[1 + 99 * d[, 2]], pointsize = 2, pixels = c(700, 700) )) }) scattermore/tests/testthat/test-rgbwt-raster-transitions-basic.R0000644000176200001440000000113414441403173024761 0ustar liggesusers test_that("rgbwt -> rgba_int -> raster transition does not fail on trivial data", { rgbwt <- scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5))) rgba_int <- expect_silent(rgbwt_to_rgba_int(rgbwt)) raster <- expect_silent(rgba_int_to_raster(rgba_int)) }) test_that("rgbwt -> rgba_float -> rgba_int -> raster transition does not fail on trivial data", { rgbwt <- scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5))) rgba_float <- expect_silent(rgbwt_to_rgba_float(rgbwt)) rgba_int <- expect_silent(rgba_float_to_rgba_int(rgba_float)) raster <- expect_silent(rgba_int_to_raster(rgba_int)) }) scattermore/tests/testthat/test-rgbwt-basic.R0000644000176200001440000000174214441403173021115 0ustar liggesusers test_that("rgbwt does not fail on different colorizations", { expect_silent(scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5)))) # palette v <- c(255, 0, 0, 100, 0, 255, 0, 25, 0, 0, 255, 50, 0, 0, 0, 100) palette <- array(v, c(4, 4)) map <- rep(c(1, 2, 3, 4), each = 25000) expect_silent(scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5)), map = map, palette = palette)) # color for each point v <- c(255, 0, 0, 100, 0, 255, 0, 10, 0, 0, 255, 10, 0, 0, 0, 0) colors <- array(v, c(4, 100000)) expect_silent(scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5)), RGBA = colors)) }) test_that("apply_kernel_rgbwt does not fail with different filters", { rgbwt <- scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5))) expect_silent(apply_kernel_rgbwt(rgbwt)) expect_silent(apply_kernel_rgbwt(rgbwt, filter = "square")) expect_silent(apply_kernel_rgbwt(rgbwt, filter = "gauss")) expect_silent(apply_kernel_rgbwt(rgbwt, filter = "own", mask = array(1, c(5, 5)))) }) scattermore/tests/testthat/test-rgbwt-lines-basic.R0000644000176200001440000000063414441403173022224 0ustar liggesuserstest_that("apply_kernel_rgbwt does not fail with different filters", { rgbwt <- expect_silent(scatter_lines_rgbwt(matrix(rnorm(40000),ncol=4,byrow=F))) expect_silent(apply_kernel_rgbwt(rgbwt)) expect_silent(apply_kernel_rgbwt(rgbwt, filter = "square")) expect_silent(apply_kernel_rgbwt(rgbwt, filter = "gauss")) expect_silent(apply_kernel_rgbwt(rgbwt, filter = "own", mask = array(1, c(5, 5)))) }) scattermore/tests/testthat/test-scattermoreplot-basic.R0000644000176200001440000000045214441403173023214 0ustar liggesusers test_that("scattermoreplot does not fail on trivial data", { expect_silent(scattermoreplot(rnorm(10), rnorm(10))) expect_silent(scattermoreplot(rnorm(10), rnorm(10), col = "red")) expect_silent(scattermoreplot(rnorm(10), rnorm(10), col = rainbow(10), xlim = c(-3, 3), ylim = c(-3, 3))) }) scattermore/tests/testthat/test-histogram-basic.R0000644000176200001440000000156414441403173021767 0ustar liggesusers test_that("scatter_points_histogram does not fail on trivial data", { expect_silent(scatter_points_histogram(cbind(rnorm(1e5), rnorm(1e5)))) }) test_that("apply_kernel_histogram does not fail with different filters", { histogram <- scatter_points_histogram(cbind(rnorm(1e5), rnorm(1e5))) expect_silent(apply_kernel_histogram(histogram)) expect_silent(apply_kernel_histogram(histogram, filter = "square")) expect_silent(apply_kernel_histogram(histogram, filter = "gauss")) expect_silent(apply_kernel_histogram(histogram, filter = "own", mask = array(1, c(5, 5)))) }) test_that("histogram_to_rgbwt does not fail", { histogram <- scatter_points_histogram(cbind(rnorm(1e5), rnorm(1e5))) expect_silent(histogram_to_rgbwt(histogram)) rgba <- array(c(250, 128, 114, 255, 144, 238, 144, 255), c(4, 2)) expect_silent(histogram_to_rgbwt(histogram, RGBA = rgba)) }) scattermore/tests/testthat/test-histogram-lines-basic.R0000644000176200001440000000160214441403173023070 0ustar liggesusers test_that("scatter_lines_histogram does not fail on trivial data", { expect_silent(scatter_lines_histogram(matrix(rnorm(40000),ncol=4,byrow=F))) }) test_that("apply_kernel_histogram does not fail with different filters", { histogram <- scatter_lines_histogram(matrix(rnorm(40000),ncol=4,byrow=F)) expect_silent(apply_kernel_histogram(histogram)) expect_silent(apply_kernel_histogram(histogram, filter = "square")) expect_silent(apply_kernel_histogram(histogram, filter = "gauss")) expect_silent(apply_kernel_histogram(histogram, filter = "own", mask = array(1, c(5, 5)))) }) test_that("histogram_to_rgbwt does not fail", { histogram <- scatter_lines_histogram(matrix(rnorm(40000),ncol=4,byrow=F)) expect_silent(histogram_to_rgbwt(histogram)) rgba <- array(c(250, 128, 114, 255, 144, 238, 144, 255), c(4, 2)) expect_silent(histogram_to_rgbwt(histogram, RGBA = rgba)) }) scattermore/tests/testthat/test-histogram-lines-pixel-overlap.R0000644000176200001440000000032114441403173024573 0ustar liggesuserstest_that("pixels do not overlap", { histogram <- scatter_lines_histogram(matrix(0.95*cbind(sin(pi*1:6/3), cos(pi*1:6/3), sin(pi*2:7/3), cos(pi*2:7/3)),ncol=4,byrow=F)) expect_equal(1, max(histogram)) }) scattermore/tests/testthat/test-merge-blend-basic.R0000644000176200001440000000113514441403173022145 0ustar liggesusers test_that("merge does not fail on trivial data", { p1 <- scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5)), RGBA = c(64, 128, 192, 50)) p2 <- scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5))) l_merge <- list(p1, p2) expect_silent(merge_rgbwt(l_merge)) }) test_that("blend does not fail on trivial data", { p1_float <- rgbwt_to_rgba_float(scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5)), RGBA = c(64, 128, 192, 50))) p2_float <- rgbwt_to_rgba_float(scatter_points_rgbwt(cbind(rnorm(1e5), rnorm(1e5)))) l_blend <- list(p1_float, p2_float) expect_silent(blend_rgba_float(l_blend)) }) scattermore/tests/testthat.R0000644000176200001440000000010214441403173015721 0ustar liggesuserslibrary(testthat) library(scattermore) test_check("scattermore") scattermore/src/0000755000176200001440000000000014441404317013373 5ustar liggesusersscattermore/src/histogram_to_rgbwt.cpp0000644000176200001440000000344714441403173020012 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "scatters.h" #include // colorize histogram with given color palette void histogram_to_rgbwt(const unsigned *dim, float *RGBWT, const float *palette, const int *histogram) { const size_t size_out_y = dim[0]; const size_t size_out_x = dim[1]; const size_t size_palette = dim[2]; const size_t size_out = size_out_y * size_out_x; for (size_t i = 0; i < size_out; ++i) { size_t histogram_value = histogram[i] < 0 ? 0 : histogram[i]; if (histogram_value >= size_palette) histogram_value = size_palette - 1; const float R = palette[4 * histogram_value + 0]; const float G = palette[4 * histogram_value + 1]; const float B = palette[4 * histogram_value + 2]; const float A = palette[4 * histogram_value + 3]; RGBWT[i + size_out * 0] = R * A; RGBWT[i + size_out * 1] = G * A; RGBWT[i + size_out * 2] = B * A; RGBWT[i + size_out * 3] = A; RGBWT[i + size_out * 4] = 1 - A; } } scattermore/src/scatter_lines_histogram.cpp0000644000176200001440000000443114441403173021014 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "scatter_lines_impl.h" #include "scatters_lines.h" // create histogram from given lines void scatter_lines_histogram(const float *xy, const unsigned *dim, const float *xlim, const float *ylim, const int *skip, unsigned *histogram) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const size_t size_data = dim[2]; const int skip_start_pixel = skip[0]; const int skip_end_pixel = skip[1]; const float x_begin = xlim[0]; const float x_end = xlim[1]; const float x_bin = (size_out_x - 1) / (x_end - x_begin); const float y_begin = ylim[1]; const float y_end = ylim[0]; const float y_bin = (size_out_y - 1) / (y_end - y_begin); // lambda expression used for individual pixel when plotting a line auto pixel_function_histogram = [histogram, size_out_x, size_out_y](size_t x, size_t y) { if (x < size_out_x && y < size_out_y) ++histogram[x * size_out_y + y]; }; for (size_t i = 0; i < size_data; ++i) { int x0 = (xy[0 * size_data + i] - x_begin) * x_bin; int y0 = (xy[1 * size_data + i] - y_begin) * y_bin; int x1 = (xy[2 * size_data + i] - x_begin) * x_bin; int y1 = (xy[3 * size_data + i] - y_begin) * y_bin; plot_line(x0, y0, x1, y1, skip_start_pixel, skip_end_pixel, pixel_function_histogram); } } scattermore/src/kernel_histogram.cpp0000644000176200001440000000436014441403173017436 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "kernels.h" #include "thread_blocks.h" #include using namespace std; // blur histogram using given kernel void kernel_histogram(const unsigned *dim, const float *kernel, float *blurred_histogram, const float *histogram) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const int radius = dim[2]; const size_t kernel_size = 2 * radius + 1; const size_t num_threads = dim[3]; const size_t block_size = 8; auto apply_kernel = [&](size_t /*thread_id*/, size_t current_pixel_x, size_t current_pixel_y) { float sum = 0; int x; for (x = -radius; x <= radius; ++x) { int y; for (y = -radius; y <= radius; ++y) { int x_shift = current_pixel_x + x; int y_shift = current_pixel_y + y; int histogram_index = (x_shift)*size_out_y + (y_shift); float kernel_value = kernel[(radius + x) * kernel_size + (radius + y)]; if (y_shift >= 0 && (size_t)y_shift < size_out_y && x_shift >= 0 && (size_t)x_shift < size_out_x) sum += histogram[histogram_index] * kernel_value; // else add nothing (zero border padding) } } blurred_histogram[current_pixel_x * size_out_y + current_pixel_y] = sum; }; threaded_foreach_2dblocks( size_out_x, size_out_y, block_size, block_size, num_threads, apply_kernel); } scattermore/src/scatter_indexed_rgbwt.cpp0000644000176200001440000000505114441403173020451 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022-2023 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "macros.h" #include "scatters.h" #include // calculate RGBWT matrix with given color palette and mapping void scatter_indexed_rgbwt(const unsigned *dim, const float *xlim, const float *ylim, const float *palette, float *RGBWT, const unsigned *map, const float *xy) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const size_t size_data = dim[2]; const size_t size_out = size_out_x * size_out_y; const size_t offset_R = size_out * 0; const size_t offset_G = size_out * 1; const size_t offset_B = size_out * 2; const size_t offset_W = size_out * 3; const size_t offset_T = size_out * 4; const size_t offset_palette = 4; const float x_begin = xlim[0]; const float x_end = xlim[1]; const float x_bin = (size_out_x - 1) / (x_end - x_begin); const float y_begin = ylim[1]; const float y_end = ylim[0]; const float y_bin = (size_out_y - 1) / (y_end - y_begin); size_t i; for (i = 0; i < size_data; ++i) { size_t x = f2i((xy[i] - x_begin) * x_bin); size_t y = f2i((xy[i + size_data] - y_begin) * y_bin); if (x >= size_out_x || y >= size_out_y) continue; size_t index = map[i]; // get index to palette float R = palette[offset_palette * index + 0]; float G = palette[offset_palette * index + 1]; float B = palette[offset_palette * index + 2]; float A = palette[offset_palette * index + 3]; size_t offset = x * size_out_y + y; RGBWT[offset + offset_R] += R * A; RGBWT[offset + offset_G] += G * A; RGBWT[offset + offset_B] += B * A; RGBWT[offset + offset_W] += A; RGBWT[offset + offset_T] *= 1 - A; } } scattermore/src/scatters_lines.h0000644000176200001440000000303714441403173016570 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #ifndef SCATTERS_LINES_H #define SCATTERS_LINES_H #ifdef __cplusplus extern "C" { #endif void scatter_lines_rgbwt(const float *xy, const unsigned *dim, const float *xlim, const float *ylim, const float *RGBA, const int *skip, float *RGBWT); void scatter_lines_histogram(const float *xy, const unsigned *dim, const float *xlim, const float *ylim, const int *skip, unsigned *histogram); #ifdef __cplusplus } #endif #endif scattermore/src/scatter_lines_impl.h0000644000176200001440000000644614441403173017435 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #ifndef SCATTERS_LINES_IMPL_H #define SCATTERS_LINES_IMPL_H #include #include template inline void plot_line_low(int x_start, int y_start, int x_finish, int y_finish, int skip_start_pixel, int skip_end_pixel, PF pixel_function) { int dx = x_finish - x_start; int dy = y_finish - y_start; int yi = 1; if (dy < 0) { yi = -1; dy = -dy; } int two_dy = 2 * dy; int two_dxy = 2 * (dy - dx); int D = two_dy - dx; int x = x_start, y = y_start; if (skip_start_pixel == 1) { if (D > 0) { y += yi; D += two_dxy; } else D += two_dy; ++x; } if (skip_end_pixel == 1) --x_finish; for (; x <= x_finish; ++x) { pixel_function(x, y); if (D > 0) { y += yi; D += two_dxy; } else D += two_dy; } } template inline void plot_line_high(int x_start, int y_start, int x_finish, int y_finish, int skip_start_pixel, int skip_end_pixel, PF pixel_function) { int dx = x_finish - x_start; int dy = y_finish - y_start; int xi = 1; if (dx < 0) { xi = -1; dx = -dx; } int two_dx = 2 * dx; int two_dxy = 2 * (dx - dy); int D = two_dx - dy; int x = x_start, y = y_start; if (skip_start_pixel == 1) { if (D > 0) { x += xi; D += two_dxy; } else D += two_dx; ++y; } if (skip_end_pixel == 1) --y_finish; for (; y <= y_finish; ++y) { pixel_function(x, y); if (D > 0) { x += xi; D += two_dxy; } else D += two_dx; } } template inline void plot_line(int x0, int y0, int x1, int y1, int skip_start_pixel, int skip_end_pixel, PF pixel_function) { /* * Bresenham algorithm; this is the initial case division, actual plotting is * handled by plot_line_low and plot_line_high. */ if (abs(y1 - y0) < abs(x1 - x0)) { if (x0 > x1) plot_line_low( x1, y1, x0, y0, skip_end_pixel, skip_start_pixel, pixel_function); else plot_line_low( x0, y0, x1, y1, skip_start_pixel, skip_end_pixel, pixel_function); } else { if (y0 > y1) plot_line_high( x1, y1, x0, y0, skip_end_pixel, skip_start_pixel, pixel_function); else plot_line_high( x0, y0, x1, y1, skip_start_pixel, skip_end_pixel, pixel_function); } } #endif scattermore/src/scatters.h0000644000176200001440000000445114441403173015377 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #ifndef SCATTERS_H #define SCATTERS_H #ifdef __cplusplus extern "C" { #endif void scatter_histogram(const unsigned *pn, const unsigned *size_out, unsigned *histogram, const float *xlim, const float *ylim, const float *xy); void scatter_singlecolor_rgbwt(const unsigned *dim, const float *xlim, const float *ylim, const float *RGBA, float *RGBWT, const float *xy); void scatter_multicolor_rgbwt(const unsigned *dim, const float *xlim, const float *ylim, const float *RGBA, float *RGBWT, const float *xy); void scatter_indexed_rgbwt(const unsigned *dim, const float *xlim, const float *ylim, const float *palette, float *RGBWT, const unsigned *map, const float *xy); void histogram_to_rgbwt(const unsigned *dim, float *RGBWT, const float *pallete, const int *histogram); #ifdef __cplusplus } #endif #endif scattermore/src/scatter_lines_rgbwt.cpp0000644000176200001440000000617114441403173020147 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "scatter_lines_impl.h" #include "scatters_lines.h" #include // draw given lines void scatter_lines_rgbwt(const float *xy, const unsigned *dim, const float *xlim, const float *ylim, const float *RGBA, const int *skip, float *RGBWT) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const size_t size_data = dim[2]; const size_t size_out = size_out_y * size_out_x; const size_t offset_R = size_out * 0; const size_t offset_G = size_out * 1; const size_t offset_B = size_out * 2; const size_t offset_W = size_out * 3; const size_t offset_T = size_out * 4; const int skip_start_pixel = skip[0]; const int skip_end_pixel = skip[1]; const float x_begin = xlim[0]; const float x_end = xlim[1]; const float x_bin = (size_out_x - 1) / (x_end - x_begin); const float y_begin = ylim[1]; const float y_end = ylim[0]; const float y_bin = (size_out_y - 1) / (y_end - y_begin); float R = RGBA[0]; float G = RGBA[1]; float B = RGBA[2]; float A = RGBA[3]; // lambda expression used for individual pixel when plotting a line auto pixel_function_rgbwt = [R, G, B, A, size_out_x, size_out_y, offset_R, offset_G, offset_B, offset_W, offset_T, RGBWT](size_t x, size_t y) { if (x < size_out_x && y < size_out_y) { size_t offset = x * size_out_y + y; RGBWT[offset + offset_R] += R * A; RGBWT[offset + offset_G] += G * A; RGBWT[offset + offset_B] += B * A; RGBWT[offset + offset_W] += A; RGBWT[offset + offset_T] *= 1 - A; } }; for (size_t i = 0; i < size_data; ++i) { int x0 = (xy[0 * size_data + i] - x_begin) * x_bin; int y0 = (xy[1 * size_data + i] - y_begin) * y_bin; int x1 = (xy[2 * size_data + i] - x_begin) * x_bin; int y1 = (xy[3 * size_data + i] - y_begin) * y_bin; plot_line( x0, y0, x1, y1, skip_start_pixel, skip_end_pixel, pixel_function_rgbwt); } } scattermore/src/scatter_singlecolor_rgbwt.cpp0000644000176200001440000000446414441403173021360 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022-2023 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "macros.h" #include "scatters.h" #include // calculate RGBWT matrix with one given color void scatter_singlecolor_rgbwt(const unsigned *dim, const float *xlim, const float *ylim, const float *RGBA, float *RGBWT, const float *xy) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const size_t size_data = dim[2]; const size_t size_out = size_out_x * size_out_y; const size_t offset_R = size_out * 0; const size_t offset_G = size_out * 1; const size_t offset_B = size_out * 2; const size_t offset_W = size_out * 3; const size_t offset_T = size_out * 4; const float x_begin = xlim[0]; const float x_end = xlim[1]; const float x_bin = (size_out_x - 1) / (x_end - x_begin); const float y_begin = ylim[1]; const float y_end = ylim[0]; const float y_bin = (size_out_y - 1) / (y_end - y_begin); float R = RGBA[0]; float G = RGBA[1]; float B = RGBA[2]; float A = RGBA[3]; size_t i; for (i = 0; i < size_data; ++i) { size_t x = f2i((xy[i] - x_begin) * x_bin); size_t y = f2i((xy[i + size_data] - y_begin) * y_bin); if (x >= size_out_x || y >= size_out_y) continue; size_t offset = x * size_out_y + y; RGBWT[offset + offset_R] += R * A; RGBWT[offset + offset_G] += G * A; RGBWT[offset + offset_B] += B * A; RGBWT[offset + offset_W] += A; RGBWT[offset + offset_T] *= 1 - A; } } scattermore/src/scattermore.c0000644000176200001440000000332014441403173016064 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include #include #include "kernels.h" #include "scatters.h" #include "scatters_lines.h" static const R_CMethodDef cMethods[] = { { "scatter_histogram", (DL_FUNC)&scatter_histogram, 6 }, { "kernel_histogram", (DL_FUNC)&kernel_histogram, 4 }, { "histogram_to_rgbwt", (DL_FUNC)&histogram_to_rgbwt, 4 }, { "scatter_singlecolor_rgbwt", (DL_FUNC)&scatter_singlecolor_rgbwt, 6 }, { "scatter_multicolor_rgbwt", (DL_FUNC)&scatter_multicolor_rgbwt, 6 }, { "scatter_indexed_rgbwt", (DL_FUNC)&scatter_indexed_rgbwt, 7 }, { "kernel_rgbwt", (DL_FUNC)&kernel_rgbwt, 4 }, { "scatter_lines_rgbwt", (DL_FUNC)&scatter_lines_rgbwt, 7 }, { "scatter_lines_histogram", (DL_FUNC)&scatter_lines_histogram, 6 }, { NULL, NULL, 0 } }; void // # nocov start R_init_Scattermore(DllInfo *info) { R_registerRoutines(info, cMethods, NULL, NULL, NULL); R_useDynamicSymbols(info, FALSE); } // # nocov end scattermore/src/scatter_multicolor_rgbwt.cpp0000644000176200001440000000465114441403173021227 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022-2023 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "macros.h" #include "scatters.h" #include // calculate RGBWT matrix with given color for each point void scatter_multicolor_rgbwt(const unsigned *dim, const float *xlim, const float *ylim, const float *RGBA, float *RGBWT, const float *xy) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const size_t size_data = dim[2]; const size_t size_out = size_out_x * size_out_y; const size_t offset_R = size_out * 0; const size_t offset_G = size_out * 1; const size_t offset_B = size_out * 2; const size_t offset_W = size_out * 3; const size_t offset_T = size_out * 4; const size_t offset_RGBA = 4; const float x_begin = xlim[0]; const float x_end = xlim[1]; const float x_bin = (size_out_x - 1) / (x_end - x_begin); const float y_begin = ylim[1]; const float y_end = ylim[0]; const float y_bin = (size_out_y - 1) / (y_end - y_begin); size_t i; for (i = 0; i < size_data; ++i) { size_t x = f2i((xy[i] - x_begin) * x_bin); size_t y = f2i((xy[i + size_data] - y_begin) * y_bin); if (x >= size_out_x || y >= size_out_y) continue; float R = RGBA[offset_RGBA * i + 0]; float G = RGBA[offset_RGBA * i + 1]; float B = RGBA[offset_RGBA * i + 2]; float A = RGBA[offset_RGBA * i + 3]; size_t offset = x * size_out_y + y; RGBWT[offset + offset_R] += R * A; RGBWT[offset + offset_G] += G * A; RGBWT[offset + offset_B] += B * A; RGBWT[offset + offset_W] += A; RGBWT[offset + offset_T] *= 1 - A; } } scattermore/src/kernels.h0000644000176200001440000000241214441403173015205 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #ifndef KERNELS_H #define KERNELS_H #ifdef __cplusplus extern "C" { #endif void kernel_histogram(const unsigned *dim, const float *kernel, float *blurred_histogram, const float *histogram); void kernel_rgbwt(const unsigned *dim, const float *kernel, float *blurred_RGBWT, const float *RGBWT); #ifdef __cplusplus } #endif #endif scattermore/src/macros.h0000644000176200001440000000205314441403173015027 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022-2023 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #ifndef MACROS_H #define MACROS_H #include #include inline size_t f2i(float x) { if (x < 0 || x > float(std::numeric_limits::max())) return std::numeric_limits::max(); return size_t(x); } #endif scattermore/src/scatter_histogram.cpp0000644000176200001440000000332114441403173017617 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022-2023 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "macros.h" #include "scatters.h" #include void scatter_histogram(const unsigned *pn, const unsigned *size_out, unsigned *histogram, const float *xlim, const float *ylim, const float *xy) { const size_t size_data = *pn; const size_t size_out_x = size_out[0]; const size_t size_out_y = size_out[1]; const float x_begin = xlim[0]; const float x_end = xlim[1]; const float x_bin = (size_out_x - 1) / (x_end - x_begin); const float y_begin = ylim[1]; const float y_end = ylim[0]; const float y_bin = (size_out_y - 1) / (y_end - y_begin); for (size_t i = 0; i < size_data; ++i) { size_t x = f2i((xy[i] - x_begin) * x_bin); size_t y = f2i((xy[i + size_data] - y_begin) * y_bin); if (x >= size_out_x || y >= size_out_y) continue; ++histogram[x * size_out_y + y]; } } scattermore/src/kernel_rgbwt.cpp0000644000176200001440000000576214441403173016575 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include "kernels.h" #include "thread_blocks.h" #include #include #include #include using namespace std; // blur data using its RGBWT matrix with given kernel void kernel_rgbwt(const unsigned *dim, const float *kernel, float *blurred_RGBWT, const float *RGBWT) { const size_t size_out_x = dim[0]; const size_t size_out_y = dim[1]; const int radius = dim[2]; const size_t size_kernel = radius * 2 + 1; const size_t size_out = size_out_x * size_out_y; const size_t num_threads = dim[3]; const size_t block_size = 8; const size_t offset_R = size_out * 0; const size_t offset_G = size_out * 1; const size_t offset_B = size_out * 2; const size_t offset_W = size_out * 3; const size_t offset_T = size_out * 4; auto apply_kernel = [&](size_t /*thread_id*/, size_t current_pixel_x, size_t current_pixel_y) { float R = 0, G = 0, B = 0, W = 0, T = 1; size_t offset = current_pixel_x * size_out_y + current_pixel_y; int x; for (x = -radius; x <= radius; ++x) { // blurring region around given point int y; for (y = -radius; y <= radius; ++y) { int x_shift = current_pixel_x + x; int y_shift = current_pixel_y + y; if (x_shift < 0 || x_shift >= (int)size_out_x || y_shift < 0 || y_shift >= (int)size_out_y) continue; size_t offset_shift = x_shift * size_out_y + y_shift; float kernel_value = kernel[(radius + x) * size_kernel + (radius + y)]; R += RGBWT[offset_shift + offset_R] * kernel_value; G += RGBWT[offset_shift + offset_G] * kernel_value; B += RGBWT[offset_shift + offset_B] * kernel_value; W += RGBWT[offset_shift + offset_W] * kernel_value; T *= 1 - ((1 - RGBWT[offset_shift + offset_T]) * kernel_value); } } blurred_RGBWT[offset + offset_R] = R; blurred_RGBWT[offset + offset_G] = G; blurred_RGBWT[offset + offset_B] = B; blurred_RGBWT[offset + offset_W] = W; blurred_RGBWT[offset + offset_T] = T; }; threaded_foreach_2dblocks( size_out_x, size_out_y, block_size, block_size, num_threads, apply_kernel); } scattermore/src/thread_blocks.h0000644000176200001440000001006514441403173016351 0ustar liggesusers/* * This file is part of scattermore. * * Copyright (C) 2022 Mirek Kratochvil * 2022-2023 Tereza Kulichova * * scattermore is free software: you can redistribute it and/or modify it under * the terms of the GNU General Public License as published by the Free * Software Foundation, either version 3 of the License, or (at your option) * any later version. * * scattermore is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License along with * scattermore. If not, see . */ #include #include using namespace std; template constexpr i n_blocks(i size_out, i block_size) { return (size_out + block_size - 1) / block_size; } template void threaded_foreach_1dblocks(size_t size_out, size_t block_size, size_t num_threads, F func) { if (num_threads == 0) num_threads = thread::hardware_concurrency(); if (num_threads == 1) { for (size_t i = 0; i < size_out; ++i) func(0, i); return; } // zero blocksize = equal thread split size_t num_blocks = block_size == 0 ? num_threads : n_blocks(size_out, block_size); vector threads(num_threads); for (size_t i = 0; i < num_threads; ++i) threads[i] = thread( [&](size_t thread_id) { for (size_t block_id = thread_id; block_id < num_blocks; block_id += num_threads) { size_t block_begin = block_id * size_out / num_blocks; size_t block_end = (block_id + 1) * size_out / num_blocks; for (size_t j = block_begin; j < block_end; ++j) func(thread_id, j); } }, i); for (size_t i = 0; i < num_threads; ++i) threads[i].join(); } template void threaded_foreach_2dblocks(size_t size_out_x, size_t size_out_y, size_t block_size_x, size_t block_size_y, size_t num_threads, F func) { if (num_threads == 0) num_threads = thread::hardware_concurrency(); size_t num_blocks_x = n_blocks(size_out_x, block_size_x); size_t num_blocks_y = n_blocks(size_out_y, block_size_y); size_t num_blocks = num_blocks_x * num_blocks_y; if (num_threads == 1) { for (size_t Y = 0; Y < num_blocks_y; ++Y) for (size_t X = 0; X < num_blocks_x; ++X) for (size_t y = 0; y < block_size_y; ++y) { size_t current_block_pixel_y = Y * block_size_y + y; if (current_block_pixel_y >= size_out_y) break; for (size_t x = 0; x < block_size_x; ++x) { size_t current_block_pixel_x = X * block_size_x + x; if (current_block_pixel_x >= size_out_x) break; func(0, current_block_pixel_x, current_block_pixel_y); } } return; } vector threads(num_threads); for (size_t i = 0; i < num_threads; ++i) threads[i] = thread( [&](size_t thread_id) { for (size_t block_id = thread_id; block_id < num_blocks; block_id += num_threads) { size_t Y = block_id / num_blocks_x; size_t X = block_id % num_blocks_x; for (size_t y = 0; y < block_size_y; ++y) { size_t current_block_pixel_y = Y * block_size_y + y; if (current_block_pixel_y >= size_out_y) break; for (size_t x = 0; x < block_size_x; ++x) { size_t current_block_pixel_x = X * block_size_x + x; if (current_block_pixel_x >= size_out_x) break; func(thread_id, current_block_pixel_x, current_block_pixel_y); } } } }, i); for (size_t i = 0; i < num_threads; ++i) threads[i].join(); } scattermore/vignettes/0000755000176200001440000000000014441404317014614 5ustar liggesusersscattermore/vignettes/low_level_interface.Rmd0000644000176200001440000003004414441403173021270 0ustar liggesusers--- title: "Low-level scattermore API" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Low-level scattermore API} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup} library(scattermore) set.seed(2023) ``` ```{r, echo=FALSE} # this somehow fails on macs if(Sys.info()["sysname"] != "Darwin") options(bitmapType='cairo') ``` # Low-level interface of Scattermore This vignette gives an overview and comprehensive examples of using the low-level API of `scattermore`. Using the API you can do many more things than just plotting points; mainly `scattermore` supports plotting both 2D-histograms (density plots) and image rasters from both points and lines (and possibly other shapes in the future), modifying and expanding both histograms and image rasters with kernels, and blending all of these using ordering-independent blending methods. The low-level API operates mostly on plain R matrices or arrays; these are formatted in: - integer and floating-point histograms/densities - RGBWT-formatted rasters - floating-point RGBA-formatted rasters with colors "premultiplied" by alpha channel for easier blending - integer RGBA-formatted rasters (without premultiplication) One typically starts with either generating the densities or RGBWT rasters, and successively moves lower in the list towards the usual integer RGBA, which may be e.g. converted to a normal R raster. RGBWT format is specific to `scattermore`, standing for Red Green Blue Weight Transparency. It is similar to a floating-point RGBA with premultiplied alpha: channels R, G, B behave just like in RGBA, channel T is equivalent to (1-A), and channel W (initially equivalent to A) collect the total amount of "paint" that the given pixel has accumulated. With this, blending of layers is guaranteed to be order independent: values in channels RGBW are added together, and values in T are multiplied. To convert RGBWT back to RGBA, one computes A=(1-T), and divides the channels R,G,B by the value of W. ## Plotting data as densities Let us first generate a small random dataset of points and directions: ```{r} n <- 10000 pts <- matrix(rnorm(n*2), n, 2) pts2 <- cbind(5+rnorm(n), -5*rexp(n)) ``` We can convert the density data to an integer density map: ```{r, dev='jpeg'} pdens <- scattermore::scatter_points_histogram(pts, out_size=c(128,128)) par(mar = c(0,0,0,0), bg='white') image(pdens) ``` The same can be done for plotting the densities over the lines: ```{r, dev='jpeg'} ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256)) par(mar = c(0,0,0,0), bg='white') image(ldens) ``` Densities are simple matrices, so in order to improve the visualization you can apply the usual R math functions to their contents: ```{r, dev='jpeg'} ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256)) par(mar = c(0,0,0,0), bg='white') image(log1p(ldens)) ``` ## Plotting data as colored pixels Colored stuff is usually plotted to a 5-channel RGBWT raster format, which eliminates the typical overplotting artifacts. This is later converted to either RGBA or a standard R rasters for plotting. We can plot the points with a single color to the RGBWT format using `scatter_points_rgbwt`. We also show how to fix the precise displayed area using `xlim` and `ylim`. ```{r, dev='jpeg'} # TODO xlim docs rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,3), ylim=c(-3,3)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` You can specify a single color (possibly with alpha channel) for plotting; here we force a lower resolution and turn off pixel interpolation to show the transparency effect more precisely: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb('#8010f010', alpha=T)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ``` The `RGBA` parameter may also assign individual colors to each pixel: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb(rainbow(n, alpha=0.3), alpha=T)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ``` For plotting large clusters that share the colors, arguments `map` and `palette` allow for simpler and more efficient specification of the plotting: ```{r, dev='jpeg'} clusters <- 1 + (pts[,1] < 0) + 2 * (pts[,2] < 0) rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), palette=col2rgb(rainbow(4, alpha=0.2), alpha=T), map=clusters) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ``` Colored RGBWT lines are plotted similarly: ```{r, dev='jpeg'} #TODO as.vector rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#8010f005', alpha=T))) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` ## Expanding densities and RGBWT plots Scattermore takes a distinctive approach to plotting points that are larger than a single pixel -- these are not plotted immediately as large, but instead start as single-pixel "centers" and are later expanded using a kernel function. The expansion is faster for plots that contain huge values of individual points, because the "expansion" operations is aggregated for multiple pixels, and the operation is much more computationally regular, giving additional speedups. First, let's increase the resolution of the example from above: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` This is sub-optimal because the pixels are too small; to fix that we can expand them: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.1), alpha=T), map=clusters) rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=10) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` There are also other expansion options (such as `gauss` and `square`). You can also supply your own kernel in order to plot different shapes of pixels: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=1), alpha=T), map=clusters) rgbwt <- apply_kernel_rgbwt(rgbwt, 'own', mask=outer(1:11, 1:11, Vectorize(function(x,y) 1/(x*y)))) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` The same can be applied to line data to get thicker lines (we limit the number of lines for simplicity here): ```{r, dev='jpeg'} rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2)[1:30,], out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#8010f010', alpha=T))) rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=5) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` Gaussian kernels are excellent for smoothing out point and line densities. As the main change, we need to use the histogram-specific kernel function: ```{r, dev='jpeg'} pdens <- scattermore::scatter_points_histogram(pts, out_size=c(256,256), xlim=c(-3,3), ylim=c(-3,3)) pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10) par(mar = c(0,0,0,0), bg='white') image(pdens, col=rainbow(100)) ``` The calculated densities can be trivially used for overlaying the images with contours. (N. B. that the default gaussian kernels are not "balanced" and increase the total weight present in the graphics; you may still supply a unit weight kernel using the `own` parameter.) ```{r, dev='jpeg'} par(mar = c(0,0,0,0), bg='white') image(pdens, col=topo.colors(100)[20:100]) contour(pdens-15, levels=c(-10,0,30), add=T) ``` ## Coloring densities Specific functionality is provided for converting densities to colorized "heat" maps, converting the histogram to RGBWT format. This is useful for later blending with other RGBWT data. ```{r, dev='jpeg'} pdens <- scattermore::scatter_points_histogram(pts, out_size=c(512,512)) pdens <- apply_kernel_histogram(pdens, 'circle', radius=10) rgbwt <- histogram_to_rgbwt(log1p(pdens), col=topo.colors(100)[10:100]) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` ## Merging RGBWT and RGBA layers Functions for blending ("merging") the RGBWT and RGBA layers are available with one substantial difference: - Merging RGBWT layers never causes overplotting. The layers are merged to produce a weighted mean, with neither being "on top". - Merging RGBA layers explicitly covers one layer by the other one, depending on the alpha value. To showcase this functionality, we show the difference between truly merging and overlaying our data. First, it is necessary to manually ensure that the data is plotted at the same bitmap size with the same coordinates: ```{r} rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#ffcc0010', alpha=T))) rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3) ``` We now merge the data as RGBWT, without overplotting either layer. Notably, the `merge_rgbwt` operation is associative and commutative (except for small numerical imperfections). ```{r, dev='jpeg'} rgbwt <- merge_rgbwt(list(rgbwt1, rgbwt2)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` In this case, neither the lines and points is "in foreground", the colors are correctly merged according to the total amount of "ink" applied to each point in the canvas. If blending in RGBA format, the colors will overlay depending on the order. First with lines on top: ```{r, dev='jpeg'} rgbwt <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt1), rgbwt_to_rgba_float(rgbwt2))) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` ...and with points on top: ```{r, dev='jpeg'} rgba <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt2), rgbwt_to_rgba_float(rgbwt1))) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` For demonstration, we produce a huge, colorful, truly psychidelic graphics that combines all of the elements: ```{r, dev='jpeg'} # lines rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#fff0c018', alpha=T))) # points rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3) # background density of the line endpoints pdens <- scatter_points_histogram(pts2, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2)) pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10) rgbwt3 <- histogram_to_rgbwt(sqrt(pdens), RGBA=col2rgb(topo.colors(100)[20:100], alpha=T)) rgba <- blend_rgba_float(list( rgbwt_to_rgba_float(merge_rgbwt(list(rgbwt1, rgbwt2))), rgbwt_to_rgba_float(rgbwt3) )) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba)) par(mar=c(2,2,0.5,0.5), bg='white') plot(c(), xlim=c(-3,7), ylim=c(-5,2)) rasterImage(t(rstr), xleft=-3, xright=7, ybottom=-5, ytop=2) # a trick is required to flip the bitmap vertically contour(seq(-3,7,length.out=512), y=seq(-5,2,length.out=512), pdens[,ncol(pdens):1], add=T, levels=c(2,10)) ``` ## Exporting high-quality graphics Running the graphics through the R plotting pipeline may result in losing pixel-perfect details by interpolating to a slightly imprecise raster. One may save RGBA format to PNG graphics directly, which gives pixel-perfect output together with some other properties (such as preserved transparency). ```{r, eval=FALSE} png::writePNG(rgba_float_to_rgba_int(rgba)/255, "myPicture.png") ``` scattermore/R/0000755000176200001440000000000014441403173013004 5ustar liggesusersscattermore/R/apply_kernel_rgbwt.R0000644000176200001440000000551614441403173017030 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' apply_kernel_rgbwt #' #' Apply a kernel to the given RGBWT raster. #' #' @param fRGBWT RGBWT array with channels `red`, `green`, `blue`, `weight` and `transparency`. The dimension should be N times M times 5. #' #' @param filter Use the pre-defined filter, either `circle`, `square`, `gauss`. Defaults to `circle`. #' #' @param mask Custom kernel used for blurring, overrides `filter`. Must be a square matrix of odd size. #' #' @param radius Radius of the kernel (counted without the "middle" pixel"), defaults to 2. The generated kernel matrix will be a square with (2*radius+1) pixels on each side. #' #' @param sigma Radius of the Gaussian function selected by `filter`, defaults to `radius/2`. #' #' @param threads Number of parallel threads (default 0 chooses hardware concurrency). #' #' @return RGBWT matrix. #' #' @export #' @useDynLib scattermore, .registration=TRUE apply_kernel_rgbwt <- function(fRGBWT, filter = "circle", mask = default_kernel(filter, radius, sigma), radius = 2, sigma = radius / 2, threads = 0) { if (threads < 0) stop("number of threads must not be negative") if (!is.array(fRGBWT) || dim(fRGBWT)[3] != 5) stop("bad fRGBWT format") size_y <- dim(fRGBWT)[1] size_x <- dim(fRGBWT)[2] blurred_fRGBWT <- array(0, c(size_y, size_x, 5)) blurred_fRGBWT[, , 5] <- 1 # initialize transparency (multiplicative) if (!is.matrix(mask) && !is.array(mask)) stop("kernel in matrix or array form expected") if (dim(mask)[1] != dim(mask)[2]) stop("kernel in square matrix expected") if (dim(mask)[1] %% 2 == 0) stop("kernel with odd size expected") kernel_pixels <- floor(dim(mask)[1] / 2) result <- .C("kernel_rgbwt", dimen = as.integer(c(size_x, size_y, kernel_pixels, threads)), kernel = as.single(mask), blurred_fRGBWT = as.single(blurred_fRGBWT), fRGBWT = as.single(fRGBWT) ) blurred_fRGBWT <- array(result$blurred_fRGBWT, c(size_y, size_x, 5)) return(blurred_fRGBWT) } scattermore/R/scatter_lines_histogram.R0000644000176200001440000000572314441403173020052 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' scatter_lines_histogram #' #' Render lines into a histogram. #' #' @param xy 4-column matrix with point coordinates. #' Each row contains X and Y coordinates of line start and X and Y coordinates of line end, in this order. #' #' @param xlim,ylim 2-element vector of rendered area limits (position of the first pixel on the #' left/top, and the last pixel on the right/bottom). #' You can flip the image coordinate system by flipping the `*lim` vectors. #' #' @param out_size 2-element vector size of the result raster, defaults to `c(512L,512L)`. #' #' @param skip_start_pixel TRUE if the start pixel of the lines should be omitted, defaults to `FALSE`. #' #' @param skip_end_pixel TRUE if the end pixel of a line should be omitted, defaults to `TRUE`. #' (When plotting long ribbons of connected lines, this prevents counting the connecting pixels twice.) #' #' @return Histogram with the rendered lines. #' #' @export #' @useDynLib scattermore, .registration=TRUE scatter_lines_histogram <- function(xy, xlim = c(min(xy[, c(1, 3)]), max(xy[, c(1, 3)])), ylim = c(min(xy[, c(2, 4)]), max(xy[, c(2, 4)])), out_size = c(512L, 512L), skip_start_pixel = FALSE, skip_end_pixel = TRUE) { if (!is.numeric(xlim) || length(xlim) != 2) stop("invalid xlim") if (!is.numeric(ylim) || length(ylim) != 2) stop("invalid ylim") if (!is.numeric(out_size) || length(out_size) != 2) stop("invalid out_size") n <- if ((is.matrix(xy) || is.array(xy)) && dim(xy)[2] == 4) { dim(xy)[1] } else { stop("invalid line coordinates in xy (expected 4-column matrix)") } size_x <- as.integer(out_size[1]) size_y <- as.integer(out_size[2]) result <- .C("scatter_lines_histogram", xy = as.single(xy), dimen = as.integer(c(size_x, size_y, n)), xlim = as.single(xlim), ylim = as.single(ylim), skip_pixel = as.integer(c(skip_start_pixel, skip_end_pixel)), i32histogram = integer(size_x * size_y) ) return(array(result$i32histogram, c(size_y, size_x))) } scattermore/R/globals.R0000644000176200001440000000151514441403173014554 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . scattermore.globals <- list( epsilon = 1e-9 ) scattermore/R/rgba_float_to_rgba_int.R0000644000176200001440000000301414441403173017574 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' rgba_float_to_rgba_int #' #' Convert a float RGBA bitmap with pre-multiplied alpha to integer RGBA bitmap. #' #' @param fRGBA RGBA bitmap in N-by-M-by-4 array. #' #' @return RGBA matrix. The output *is not premultiplied* by alpha. #' #' @export #' @useDynLib scattermore, .registration=TRUE rgba_float_to_rgba_int <- function(fRGBA) { if (!is.array(fRGBA) || dim(fRGBA)[3] != 4) stop("unsupported fRGBA format") A <- 255 / pmax(scattermore.globals$epsilon, fRGBA[, , 4]) # unpremultiply i32RGBA <- array(0L, dim(fRGBA)) i32RGBA[, , 1] <- as.integer(fRGBA[, , 1] * A) i32RGBA[, , 2] <- as.integer(fRGBA[, , 2] * A) i32RGBA[, , 3] <- as.integer(fRGBA[, , 3] * A) i32RGBA[, , 4] <- as.integer(255 * fRGBA[, , 4]) return(i32RGBA) } scattermore/R/scatter_lines_rgbwt.R0000644000176200001440000000643014441403173017176 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' scatter_lines_rgbwt #' #' Render lines into a RGBWT bitmap. #' #' @param xy 4-column matrix with point coordinates. #' Each row contains X and Y coordinates of line start and X and Y coordinates of line end, in this order. #' #' @param xlim,ylim 2-element vector of rendered area limits (position of the first pixel on the #' left/top, and the last pixel on the right/bottom). #' You can flip the image coordinate system by flipping the `*lim` vectors. #' #' @param out_size 2-element vector size of the result raster, defaults to `c(512L,512L)`. #' #' @param RGBA Vector of 4 elements with integral RGBA color for the lines, defaults to `c(0,0,0,255)`. #' #' @param skip_start_pixel TRUE if the start pixel of the lines should be omitted, defaults to `FALSE`. #' #' @param skip_end_pixel TRUE if the end pixel of a line should be omitted, defaults to `TRUE`. #' (When plotting long ribbons of connected lines, this prevents counting the connecting pixels twice.) #' #' @return Lines plotted in RGBWT bitmap. #' #' @export #' @useDynLib scattermore, .registration=TRUE scatter_lines_rgbwt <- function(xy, xlim = c(min(xy[, c(1, 3)]), max(xy[, c(1, 3)])), ylim = c(min(xy[, c(2, 4)]), max(xy[, c(2, 4)])), out_size = c(512L, 512L), RGBA = c(0, 0, 0, 255), skip_start_pixel = FALSE, skip_end_pixel = TRUE) { if (!is.numeric(xlim) || length(xlim) != 2) stop("invalid xlim") if (!is.numeric(ylim) || length(ylim) != 2) stop("invalid ylim") if (!is.numeric(out_size) || length(out_size) != 2) stop("invalid out_size") n <- if ((is.matrix(xy) || is.array(xy)) && dim(xy)[2] == 4) { dim(xy)[1] } else { stop("invalid line coordinates in xy (expected 4-column matrix)") } if (!is.numeric(RGBA) || length(RGBA) != 4) stop("invalid RGBA") size_x <- as.integer(out_size[1]) size_y <- as.integer(out_size[2]) RGBWT <- array(0, c(size_y, size_x, 5)) RGBWT[, , 5] <- 1 # initialize the transparency (multiplicative) result <- .C("scatter_lines_rgbwt", xy = as.single(xy), dimen = as.integer(c(size_x, size_y, n)), xlim = as.single(xlim), ylim = as.single(ylim), RGBA = as.single(RGBA / 255), skip_pixel = as.integer(c(skip_start_pixel, skip_end_pixel)), fRGBWT = as.single(RGBWT) ) return(array(result$fRGBWT, c(size_y, size_x, 5))) } scattermore/R/scatter_points_histogram.R0000644000176200001440000000447414441403173020256 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' scatter_points_histogram #' #' Render a 2D histogram with given points #' #' @param xy 2-column matrix with point coordinates (X and Y). #' #' @param xlim,ylim 2-element vector of rendered area limits (position of the first pixel on the #' left/top, and the last pixel on the right/bottom). #' You can flip the image coordinate system by flipping the `*lim` vectors. #' #' @param out_size 2-element vector size of the result raster, defaults to `c(512L,512L)`. #' #' @return 2D histogram with the points "counted" in appropriate pixels. #' #' @export #' @useDynLib scattermore, .registration=TRUE scatter_points_histogram <- function(xy, xlim = c(min(xy[, 1]), max(xy[, 1])), ylim = c(min(xy[, 2]), max(xy[, 2])), out_size = c(512L, 512L)) { if (dim(xy)[2] != 2) stop("2-column xy input expected") n <- dim(xy)[1] if (!is.numeric(xlim) || length(xlim) != 2) stop("invalid xlim") if (!is.numeric(ylim) || length(ylim) != 2) stop("invalid ylim") if (!is.numeric(out_size) || length(out_size) != 2) stop("invalid out_size") size_x <- as.integer(out_size[1]) size_y <- as.integer(out_size[2]) result <- .C("scatter_histogram", n = as.integer(n), out_size = as.integer(out_size), i32histogram = integer(size_x * size_y), xlim = as.single(xlim), ylim = as.single(ylim), xy = as.single(xy) ) fhistogram <- array(result$i32histogram, c(size_y, size_x)) return(fhistogram) } scattermore/R/default_kernel.R0000644000176200001440000000343114441403173016114 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022-2023 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' default_kernel #' #' Create a nice defaulted kernel for `apply_kernel_*` functions. #' Parameters are documented in the exported functions. default_kernel <- function(filter, radius, sigma) { if (!is.numeric(radius) || !is.numeric(sigma) || length(radius) != 1 || length(sigma) != 1) { stop("parameters radius and sigma must be numbers") } if (radius <= 0) stop("radius must be positive") kernel_pixels <- ceiling(radius) size <- kernel_pixels * 2 + 1 # odd size if (filter == "circle") { kernel <- matrix( pmin(1, pmax(0, -sqrt(rowSums(expand.grid(-kernel_pixels:kernel_pixels, -kernel_pixels:kernel_pixels)^2)) + radius)), size, size ) } else if (filter == "square") { kernel <- matrix(1, size, size) } else if (filter == "gauss") { kernel <- matrix( exp( -rowSums(expand.grid(-kernel_pixels:kernel_pixels, -kernel_pixels:kernel_pixels)^2) / (sigma^2) ), size, size ) } else { stop("unsupported kernel shape") } } scattermore/R/histogram_to_rgbwt.R0000644000176200001440000000456114441403173017041 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' histogram_to_rgbwt #' #' Colorize given histogram with input palette. #' #' @param fhistogram Matrix or 2D array with the histogram of values. #' #' @param RGBA 4-by-N matrix floating-point R, G, B and A channels for the palette. Overrides `col`. #' #' @param col Colors to use for coloring. #' #' @param zlim Values to use as extreme values of the histogram #' #' @return RGBWT matrix. #' #' @export #' @useDynLib scattermore, .registration=TRUE #' @importFrom grDevices col2rgb #' @importFrom grDevices hcl.colors histogram_to_rgbwt <- function(fhistogram, RGBA = grDevices::col2rgb(col, alpha = T), col = grDevices::hcl.colors(10), zlim = c(min(fhistogram), max(fhistogram))) { if (!is.matrix(fhistogram) && !is.array(fhistogram)) stop("unsupported histogram format") if (length(dim(fhistogram)) != 2) stop("unsupported histogram format") if (dim(RGBA)[1] != 4) stop("RGBA with 4 rows expected") if (dim(RGBA)[2] < 2) stop("at least 2-color palette is required") rows <- dim(fhistogram)[1] cols <- dim(fhistogram)[2] pal_size <- dim(RGBA)[2] RGBWT <- array(0, c(rows, cols, 5)) normalized_fhistogram <- pmin(pal_size, pmax( 0, pal_size * (fhistogram - zlim[1]) / max((zlim[2] - zlim[1]), scattermore.globals$epsilon) )) result <- .C("histogram_to_rgbwt", dimen = as.integer(c(rows, cols, pal_size)), fRGBWT = as.single(RGBWT), RGBA = as.single(RGBA / 255), normalized_fhistogram = as.integer(normalized_fhistogram) ) return(array(result$fRGBWT, c(rows, cols, 5))) } scattermore/R/rgbwt_to_rgba_float.R0000644000176200001440000000267414441403173017147 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' rgbwt_to_rgba_float #' #' Convert RGBWT matrix to floating-point RGBA matrix, suitable for alpha-blending. #' #' @param fRGBWT The RGBWT matrix. #' @return RGBA matrix, output *is premultiplied* by alpha. #' #' @export #' @useDynLib scattermore, .registration=TRUE rgbwt_to_rgba_float <- function(fRGBWT) { if (!is.array(fRGBWT) || dim(fRGBWT)[3] != 5) stop("unsupported fRGBWT format") A <- 1 - fRGBWT[, , 5] W <- A / pmax(scattermore.globals$epsilon, fRGBWT[, , 4]) fRGBA <- array(0, c(dim(fRGBWT)[1:2], 4)) fRGBA[, , 1] <- fRGBWT[, , 1] * W fRGBA[, , 2] <- fRGBWT[, , 2] * W fRGBA[, , 3] <- fRGBWT[, , 3] * W fRGBA[, , 4] <- A return(fRGBA) } scattermore/R/apply_kernel_histogram.R0000644000176200001440000000555514441403173017703 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' apply_kernel_histogram #' #' Apply a kernel to the given histogram. #' #' @param fhistogram Matrix or array interpreted as histogram of floating-point values. #' #' @param filter Use the pre-defined filter, either `circle`, `square`, `gauss`. Defaults to `circle`. #' #' @param mask Custom kernel used for blurring, overrides `filter`. Must be a square matrix of odd size. #' #' @param radius Radius of the kernel (counted without the "middle" pixel"), defaults to 2. The generated kernel matrix will be a square with (2*radius+1) pixels on each side. #' #' @param sigma Radius of the Gaussian function selected by `filter`, defaults to `radius/2`. #' #' @param threads Number of parallel threads (default 0 chooses hardware concurrency). #' #' @return 2D matrix with the histogram processed by the kernel application. #' #' @export #' @useDynLib scattermore, .registration=TRUE apply_kernel_histogram <- function(fhistogram, filter = "circle", mask = default_kernel(filter, radius, sigma), radius = 2, sigma = radius / 2, threads = 0) { if (!is.matrix(fhistogram) && !is.array(fhistogram)) stop("fhistogram must be a matrix") if (length(dim(fhistogram)) != 2) stop("fhistogram must be 2D") if (threads < 0) stop("number of threads must not be negative") size_y <- dim(fhistogram)[1] size_x <- dim(fhistogram)[2] if (!is.matrix(mask) && !is.array(mask)) stop("kernel in matrix or array form expected") if (dim(mask)[1] != dim(mask)[2]) stop("kernel in square matrix expected") if (dim(mask)[1] %% 2 == 0) stop("kernel with odd size expected") kernel_pixels <- floor(dim(mask)[1] / 2) result <- .C("kernel_histogram", dimen = as.integer(c(size_x, size_y, kernel_pixels, threads)), kernel = as.single(mask), blurred_fhistogram = as.single(rep(0, size_x * size_y)), fhistogram = as.single(fhistogram) ) blurred_fhistogram <- array(result$blurred_fhistogram, c(size_y, size_x)) return(blurred_fhistogram) } scattermore/R/scattermore.R0000644000176200001440000002573114441403173015467 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2019-2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' scattermore #' #' Convert points to raster scatterplot rather quickly. #' #' @param xy 2-column float matrix with point coordinates. As usual with #' rasters in R, X axis grows right, and Y axis grows DOWN. #' Flipping `ylim` causes the usual mathematical behavior. #' @param size 2-element vector integer size of the result raster, #' defaults to `c(512,512)`. #' @param xlim,ylim Float limits as usual (position of the first pixel on the #' left/top, and the last pixel on the right/bottom). You can #' easily flip the top/bottom to the "usual" mathematical #' system by flipping the `ylim` vector. #' @param rgba 4-row matrix with color values of 0-255, or just a single 4-item #' vector for `c(r,g,b,a)`. Best created with `col2rgb(..., alpha=TRUE)`. #' @param cex Additional point radius in pixels, 0=single-pixel dots (fastest) #' @param output.raster Output R-style raster (as.raster)? Default TRUE. Raw #' array output can be used much faster, #' e.g. for use with png::writePNG. #' @return Raster with the result. #' #' @useDynLib scattermore, .registration = TRUE #' @examples #' library(scattermore) #' plot(scattermore(cbind(rnorm(1e6), rnorm(1e6)), rgba = c(64, 128, 192, 10))) #' @export #' @importFrom grDevices as.raster scattermore <- function(xy, size = c(512, 512), xlim = c(min(xy[, 1]), max(xy[, 1])), ylim = c(min(xy[, 2]), max(xy[, 2])), rgba = c(0L, 0L, 0L, 255L), cex = 0, output.raster = TRUE) { scattered <- scatter_points_rgbwt(xy, out_size = size, RGBA = rgba, xlim = xlim, ylim = ylim) if (cex != 0) scattered <- apply_kernel_rgbwt(scattered, radius = cex) rgba_int <- rgbwt_to_rgba_int(scattered) if (output.raster) { rgba_int_to_raster(rgba_int) } else { rgba_int } } #' scattermoreplot #' #' Convenience base-graphics-like layer around scattermore. Currently only works with linear axes! #' #' @param x,y,xlim,ylim,xlab,ylab,... used as in [graphics::plot()] or forwarded to [graphics::plot()] #' @param col point color(s) #' @param cex forwarded to [scattermore()] #' @param pch ignored (to improve compatibility with [graphics::plot()] #' @param size forwarded to [scattermore()], or auto-derived from device and plot size if missing (the estimate is not pixel-perfect on most devices, but gets pretty close) #' @examples #' # plot an actual rainbow #' library(scattermore) #' d <- data.frame(s = qlogis(1:1e6 / (1e6 + 1), 6, 0.5), t = rnorm(1e6, pi / 2, 0.5)) #' scattermoreplot( #' d$s * cos(d$t), #' d$s * sin(d$t), #' col = rainbow(1e6, alpha = .05)[c((9e5 + 1):1e6, 1:9e5)], #' main = "scattermore demo" #' ) #' @export #' @importFrom graphics par #' @importFrom graphics plot #' @importFrom graphics rasterImage #' @importFrom grDevices dev.size #' @importFrom grDevices rgb scattermoreplot <- function(x, y, xlim, ylim, size, col = grDevices::rgb(0, 0, 0, 1), cex = 0, pch = NULL, xlab, ylab, ...) { if (missing(x)) stop("Supply at least one vector for plotting") if (!missing(y)) x <- cbind(x, y) if (missing(xlim)) xlim <- c(min(x[, 1]), max(x[, 1])) if (missing(ylim)) ylim <- c(min(x[, 2]), max(x[, 2])) xlab <- if (!missing(xlab)) xlab else if (!is.null(colnames(x))) colnames(x)[1] else "X" ylab <- if (!missing(ylab)) ylab else if (!is.null(colnames(x))) colnames(x)[2] else "Y" graphics::plot(x[1, ], pch = "", xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, ...) usr <- graphics::par("usr") if (missing(size)) { size <- as.integer( grDevices::dev.size("px") / grDevices::dev.size("in") * graphics::par("pin") ) } graphics::rasterImage( scattermore( x, size = size, xlim = usr[1:2], ylim = usr[3:4], cex = cex, rgba = grDevices::col2rgb(col, alpha = TRUE), output.raster = TRUE ), xleft = usr[1], xright = usr[2], ybottom = usr[3], ytop = usr[4], ) } #' geom_scattermore #' #' [ggplot2::ggplot()] integration. This cooperates with the rest of ggplot #' (so you can use it to e.g. add rasterized scatterplots to vector output in #' order to reduce PDF size). Note that the ggplot processing overhead still dominates #' the plotting time. Use [geom_scattermost()] to tradeoff some niceness and #' circumvent ggplot logic to gain speed. #' #' Accepts aesthetics `x`, `y`, `colour` and `alpha`. Point size is fixed for #' all points. Due to rasterization properties it is often beneficial to try #' non-integer point sizes, e.g. `3.2` looks much better than `3`. #' #' @param na.rm Remove NA values, just as with [ggplot2::geom_point()]. #' @param interpolate Default FALSE, passed to [grid::rasterGrob()]. #' @param pointsize Radius of rasterized point. Use `0` for single pixels (fastest). #' @param pixels Vector with X and Y resolution of the raster, default `c(512,512)`. #' @param mapping,data,stat,position,inherit.aes,show.legend,... passed to [ggplot2::layer()] #' @examples #' library(ggplot2) #' library(scattermore) #' ggplot(data.frame(x = rnorm(1e6), y = rexp(1e6))) + #' geom_scattermore(aes(x, y, color = x), #' pointsize = 3, #' alpha = 0.1, #' pixels = c(1000, 1000), #' interpolate = TRUE #' ) + #' scale_color_viridis_c() #' @export #' @importFrom ggplot2 layer geom_scattermore <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, interpolate = FALSE, pointsize = 0, pixels = c(512, 512)) { ggplot2::layer( data = data, mapping = mapping, stat = stat, position = position, geom = GeomScattermore, show.legend = show.legend, inherit.aes = inherit.aes, params = list( na.rm = na.rm, interpolate = interpolate, pointsize = pointsize, pixels = pixels, ... ) ) } #' The actual geom for scattermore #' #' @importFrom ggplot2 aes #' @importFrom ggplot2 draw_key_point #' @importFrom ggplot2 Geom #' @importFrom ggplot2 ggproto #' @importFrom grDevices col2rgb #' @importFrom grid rasterGrob #' @importFrom scales alpha GeomScattermore <- ggplot2::ggproto("GeomScattermore", ggplot2::Geom, required_aes = c("x", "y"), non_missing_aes = c("alpha", "colour"), default_aes = ggplot2::aes( shape = 19, colour = "black", size = 1.5, fill = NA, alpha = 1, stroke = 0.5 ), draw_panel = function(data, pp, coord, pointsize = 0, interpolate = F, na.rm = FALSE, pixels = c(512, 512)) { coords <- coord$transform(data, pp) ggplot2:::ggname( "geom_scattermore", grid::rasterGrob( scattermore( cbind(coords$x, coords$y), rgba = grDevices::col2rgb(alpha = TRUE, scales::alpha(coords$colour, coords$alpha)), cex = pointsize, xlim = c(0, 1), ylim = c(0, 1), size = pixels ), 0, 0, 1, 1, default.units = "native", just = c("left", "bottom"), interpolate = interpolate ) ) }, draw_key = ggplot2::draw_key_point ) #' geom_scattermost #' #' Totally non-ggplotish version of [geom_scattermore()], but faster. It avoids #' most of the ggplot processing by bypassing the largest portion of data #' around any ggplot functionality, leaving only enough data to set up axes and #' limits correctly. If you need to break speed records, use this. #' #' @param xy 2-column object with data, as in [scattermore()]. #' @param color Color vector (or a single color). #' @param interpolate Default FALSE, passed to [grid::rasterGrob()]. #' @param pointsize Radius of rasterized point. Use `0` for single pixels (fastest). #' @param pixels Vector with X and Y resolution of the raster, default `c(512,512)`. #' @examples #' library(ggplot2) #' library(scattermore) #' d <- data.frame(x = rnorm(1000000), y = rnorm(1000000)) #' x_rng <- range(d$x) #' ggplot() + #' geom_scattermost(cbind(d$x, d$y), #' color = heat.colors(100, alpha = .01) #' [1 + 99 * (d$x - x_rng[1]) / diff(x_rng)], #' pointsize = 2.5, #' pixels = c(1000, 1000), #' interpolate = TRUE #' ) #' @export #' @importFrom ggplot2 .data #' @importFrom ggplot2 aes #' @importFrom ggplot2 layer geom_scattermost <- function(xy, color = "black", interpolate = FALSE, pointsize = 0, pixels = c(512, 512)) { ggplot2::layer( data = data.frame( x = c(min(xy[, 1]), max(xy[, 1])), y = c(min(xy[, 2]), max(xy[, 2])) ), mapping = ggplot2::aes(x = .data$x, y = .data$y), stat = "identity", position = "identity", geom = GeomScattermost, show.legend = NA, params = list( interpolate = interpolate, pointsize = pointsize, xy = xy, co = color, pixels = pixels ) ) } #' The actual geom for scattermost #' #' @importFrom ggplot2 draw_key_point #' @importFrom ggplot2 Geom #' @importFrom ggplot2 ggproto #' @importFrom grDevices col2rgb #' @importFrom grid rasterGrob GeomScattermost <- ggplot2::ggproto("GeomScattermost", ggplot2::Geom, required_aes = c("x", "y"), draw_panel = function(data, pp, coord, pointsize = 0, interpolate = F, xy, co = "black", pixels = c(512, 512)) { coords <- coord$transform(data.frame(x = xy[, 1], y = xy[, 2]), pp) ggplot2:::ggname( "geom_scattermost", grid::rasterGrob( scattermore(cbind(coords$x, coords$y), cex = pointsize, rgba = grDevices::col2rgb(alpha = TRUE, co), xlim = c(0, 1), ylim = c(0, 1), size = pixels ), 0, 0, 1, 1, default.units = "native", just = c("left", "bottom"), interpolate = interpolate ) ) }, draw_key = ggplot2::draw_key_point ) scattermore/R/merge_rgbwt.R0000644000176200001440000000354414441403173015441 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' merge_rgbwt #' #' Merge RGBWT matrices. #' #' @param fRGBWT_list List of RGBWT arrays. The order of the matrices does not matter (except for negligible floating-point rounding and other robustness errors). #' #' @return Merged RGBWT matrix. #' #' @export #' @useDynLib scattermore, .registration=TRUE merge_rgbwt <- function(fRGBWT_list) { if (length(fRGBWT_list) < 1) stop("No input RGBWT given.") if (length(fRGBWT_list) == 1) { return(fRGBWT_list[[1]]) } fRGBWT_1 <- fRGBWT_list[[1]] if (!is.array(fRGBWT_1) || dim(fRGBWT_1)[3] != 5) stop("not supported RGBWT format") for (i in 2:length(fRGBWT_list)) { fRGBWT_2 <- fRGBWT_list[[i]] if (!is.array(fRGBWT_2) || dim(fRGBWT_2)[3] != 5) stop("not supported RGBWT format") if ((dim(fRGBWT_1)[1] != dim(fRGBWT_2)[1]) || (dim(fRGBWT_1)[2] != dim(fRGBWT_2)[2])) stop("parameters do not have same dimensions") rows <- dim(fRGBWT_1)[1] cols <- dim(fRGBWT_1)[2] fRGBWT_1[, , 1:4] <- fRGBWT_1[, , 1:4] + fRGBWT_2[, , 1:4] fRGBWT_1[, , 5] <- fRGBWT_1[, , 5] * fRGBWT_2[, , 5] } return(fRGBWT_1) } scattermore/R/scatter_points_rgbwt.R0000644000176200001440000001100614441403173017373 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' scatter_points_rgbwt #' #' Render colored points into a RGBWT bitmap #' #' @param xy 2-column matrix with N point coordinates (X and Y) in rows. #' #' @param xlim,ylim 2-element vector of rendered area limits (position of the first pixel on the #' left/top, and the last pixel on the right/bottom). #' You can flip the image coordinate system by flipping the `*lim` vectors. #' #' @param out_size 2-element vector size of the result raster, defaults to `c(512L,512L)`. #' #' @param RGBA Point colors. Either a 4-element vector that specifies the same color for all points, #' or 4-by-N matrix that specifies color for each of the individual points. #' Color is specified using integer RGBA; i.e. the default black is `c(0,0,0,255)`. #' #' @param map Vector with N integer indices to `palette`. Overrides RGBA-based coloring. #' #' @param palette Matrix 4-by-K matrix of RGBA colors used as a palette lookup for the `map` #' that gives the point colors. K is at least `max(map)`. #' Notably, using a palette may be faster than filling and processing the whole RGBA matrix. #' #' @return A RGBWT array with the rendered points. #' #' @export #' @useDynLib scattermore, .registration=TRUE scatter_points_rgbwt <- function(xy, xlim = c(min(xy[, 1]), max(xy[, 1])), ylim = c(min(xy[, 2]), max(xy[, 2])), out_size = c(512, 512), RGBA = c(0, 0, 0, 255), map = NULL, palette = NULL) { if (!is.numeric(xlim) || length(xlim) != 2) stop("invalid xlim") if (!is.numeric(ylim) || length(ylim) != 2) stop("invalid ylim") if (!is.numeric(out_size) || length(out_size) != 2) stop("invalid out_size") if (dim(xy)[2] != 2) stop("2-column xy input expected") n <- dim(xy)[1] size_x <- as.integer(out_size[1]) size_y <- as.integer(out_size[2]) RGBWT <- array(0, c(size_y, size_x, 5)) RGBWT[, , 5] <- 1 # initialize transparency (multiplying) result <- if (is.numeric(map)) { map <- as.integer(map) - 1L if (length(map) != n) stop("wrong size of map") if (any(map < 0L)) stop("indices in map must start from 1") if (!is.matrix(palette) && !is.array(palette)) stop("unsupported palette format") if (dim(palette)[1] != 4) stop("unsupported palette format") if (max(map) >= dim(palette)[2]) stop("map indices too high for this palette") .C("scatter_indexed_rgbwt", dimen = as.integer(c(size_x, size_y, n)), xlim = as.single(xlim), ylim = as.single(ylim), palette = as.single(palette / 255), fRGBWT = as.single(RGBWT), map = as.integer(map), xy = as.single(xy) ) } else if (is.vector(RGBA) || ((is.matrix(RGBA) || is.array(RGBA)) && dim(RGBA)[2] == 1)) { if (length(RGBA) != 4) stop("RGBA vector of length 4 expected") .C("scatter_singlecolor_rgbwt", dimen = as.integer(c(size_x, size_y, n)), xlim = as.single(xlim), ylim = as.single(ylim), RGBA = as.single(RGBA / 255), fRGBWT = as.single(RGBWT), xy = as.single(xy) ) } else if (is.matrix(RGBA) || is.array(RGBA)) { if (dim(RGBA)[1] != 4) stop("RGBA matrix with 4 rows expected") if (dim(RGBA)[2] == n) { .C("scatter_multicolor_rgbwt", dimen = as.integer(c(size_x, size_y, n)), xlim = as.single(xlim), ylim = as.single(ylim), RGBA = as.single(RGBA / 255), fRGBWT = as.single(RGBWT), xy = as.single(xy) ) } else { stop("incorrect number of colors in RGBA") } } else { stop("unsupported coloring type") } return(array(result$fRGBWT, c(size_y, size_x, 5))) } scattermore/R/rgbwt_to_rgba_int.R0000644000176200001440000000274314441403173016631 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' rgbwt_to_rgba_int #' #' Convert a RGBWT matrix to an integer RGBA matrix. #' #' @param fRGBWT The RGBWT matrix. #' @return A RGBA matrix. The output *is not premultiplied* by alpha. #' #' @export #' @useDynLib scattermore, .registration=TRUE rgbwt_to_rgba_int <- function(fRGBWT) { if (!is.array(fRGBWT) || dim(fRGBWT)[3] != 5) stop("not supported fRGBWT format") W <- 255 / pmax(scattermore.globals$epsilon, fRGBWT[, , 4]) i32RGBA <- array(0L, c(dim(fRGBWT)[1:2], 4)) i32RGBA[, , 1] <- as.integer(fRGBWT[, , 1] * W) i32RGBA[, , 2] <- as.integer(fRGBWT[, , 2] * W) i32RGBA[, , 3] <- as.integer(fRGBWT[, , 3] * W) i32RGBA[, , 4] <- as.integer(255 * (1 - fRGBWT[, , 5])) return(i32RGBA) } scattermore/R/blend_rgba_float.R0000644000176200001440000000416714441403173016403 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' blend_rgba_float #' #' Blend RGBA matrices. #' #' @param fRGBA_list List of floating-point RGBA arrays with premultiplied alpha (each of the same size N-by-M-by-4). The "first" matrix in the list is the one that will be rendered on "top". #' #' @return Blended RGBA matrix. #' #' @export #' @useDynLib scattermore, .registration=TRUE blend_rgba_float <- function(fRGBA_list) { if (length(fRGBA_list) < 1) stop("No input RGBA given.") if (length(fRGBA_list) == 1) { return(fRGBA_list[[1]]) } fRGBA_1 <- fRGBA_list[[1]] if (!is.array(fRGBA_1) || dim(fRGBA_1)[3] != 4) stop("unsupported RGBA format") for (i in 2:length(fRGBA_list)) { fRGBA_2 <- fRGBA_list[[i]] if (!is.array(fRGBA_2) || dim(fRGBA_2)[3] != 4) stop("unsupported RGBA format") if ((dim(fRGBA_1)[1] != dim(fRGBA_2)[1]) || (dim(fRGBA_1)[2] != dim(fRGBA_2)[2])) stop("input bitmap dimensions differ") rows <- dim(fRGBA_1)[1] cols <- dim(fRGBA_1)[2] A_1 <- fRGBA_1[, , 4] A_2 <- fRGBA_2[, , 4] fRGBA <- array(0, c(rows, cols, 4)) # blend with premultiplied alpha fRGBA[, , 1] <- fRGBA_1[, , 1] + (fRGBA_2[, , 1] * (1 - A_1)) fRGBA[, , 2] <- fRGBA_1[, , 2] + (fRGBA_2[, , 2] * (1 - A_1)) fRGBA[, , 3] <- fRGBA_1[, , 3] + (fRGBA_2[, , 3] * (1 - A_1)) fRGBA[, , 4] <- A_1 + (A_2 * (1 - A_1)) fRGBA_1 <- fRGBA } return(fRGBA_1) } scattermore/R/rgba_int_to_raster.R0000644000176200001440000000236614441403173017005 0ustar liggesusers# This file is part of scattermore. # # Copyright (C) 2022 Mirek Kratochvil # 2022-2023 Tereza Kulichova # # scattermore is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # scattermore is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with scattermore. If not, see . #' rgba_int_to_raster #' #' Create a raster from the given RGBA matrix. #' #' @param i32RGBA Integer RGBA matrix (with all values between 0 and 255). #' #' @return The matrix converted to raster. #' #' @export #' @useDynLib scattermore, .registration=TRUE #' @importFrom grDevices as.raster rgba_int_to_raster <- function(i32RGBA) { if (!is.array(i32RGBA) || dim(i32RGBA)[3] != 4) stop("unsupported i32RGBA format") return(grDevices::as.raster(i32RGBA, max = 255)) } scattermore/MD50000644000176200001440000001002414441553612013114 0ustar liggesusers5b8f7283faaf35fd7058e1143815510c *DESCRIPTION 0b98a26293dc967e7ec0bf8fa319dcc2 *NAMESPACE 4b89b20af963010257febfb809810c14 *R/apply_kernel_histogram.R 4aaba2bb0161d8b48c66c98e8653d629 *R/apply_kernel_rgbwt.R bfe89888e47366c5b26bb7ced6424f7b *R/blend_rgba_float.R 668fd7cc7064739172aa7df77b5bf101 *R/default_kernel.R a8c8e72db4dc623d31082dc173ef7435 *R/globals.R d92903f420bee36116aeab14c206e092 *R/histogram_to_rgbwt.R 8eefc5906de3b10e6c4f88d2586b45f7 *R/merge_rgbwt.R 19ece2ca00107ed1c03f10cf2e5e4c46 *R/rgba_float_to_rgba_int.R c68a26b659f07604f68ab7b5abb2e43c *R/rgba_int_to_raster.R 021accf305e6467e498407ae3f14ab96 *R/rgbwt_to_rgba_float.R 30087fb41d0bc17823580ea22f02f8fd *R/rgbwt_to_rgba_int.R ff606dd6274b198cfdd9fe38f62acbb8 *R/scatter_lines_histogram.R 191319fd067eb4490bff8d6063f3d221 *R/scatter_lines_rgbwt.R a8422033edb9acb2b5846404def2a138 *R/scatter_points_histogram.R cf1b1a58b30440e055dc458a44f5b836 *R/scatter_points_rgbwt.R 80129c122979b67a24890e2404d046c5 *R/scattermore.R 902ce6a4f39627b4d177c73fcc2636cc *build/vignette.rds 2e0090cc0ae922d8bca123ab0784f0e4 *inst/doc/low_level_interface.R 750526982d7535f8ab11f5c0c277985e *inst/doc/low_level_interface.Rmd 710b5922cfe30eefbfb3027dd5b8aba8 *inst/doc/low_level_interface.html 47ef86d5c6464a58e7d6ffa0f0005428 *man/GeomScattermore.Rd f2e9dd0618c4c495efb68aa0ef1d23d1 *man/GeomScattermost.Rd b0f213c34cf4972070fb9b3800b75f17 *man/apply_kernel_histogram.Rd e97edc878cb8b14d3a98c881aaef55a4 *man/apply_kernel_rgbwt.Rd 31b5a3990fd61c9af8086272df7da6cd *man/blend_rgba_float.Rd a31f67c73653b674d922b89de2a88fbe *man/geom_scattermore.Rd 87650cda4ec880974cd3fb46d3fa138d *man/geom_scattermost.Rd f495e53f39f133ee26fad3a2607da8d5 *man/histogram_to_rgbwt.Rd ad599b75c59680400ce34b4a3f50c83d *man/merge_rgbwt.Rd c46bf1b4f9dffcbb442064fa2bcddff0 *man/rgba_float_to_rgba_int.Rd 7b8ffd28abed981af97318799478a17c *man/rgba_int_to_raster.Rd 6208d15340472a6f0a4040705d33a95e *man/rgbwt_to_rgba_float.Rd 8c66f9a077e5cf33ad8937ce5567f8a7 *man/rgbwt_to_rgba_int.Rd 2fe14d7b3454cdd731cb1c0e510b6d2b *man/scatter_lines_histogram.Rd 6429480a65d7f49447fd3d666696b3c3 *man/scatter_lines_rgbwt.Rd 3a80104c1c4982f866181161fb0a425c *man/scatter_points_histogram.Rd a8d12e54c6c2ccaaff48dcbb0e3b8ec3 *man/scatter_points_rgbwt.Rd 82637abba992cfeb62a2e76bab82f8c3 *man/scattermore.Rd f8e95b7e56ae79db1fbeddc72e93da5a *man/scattermoreplot.Rd 360821a4d0528fc57a86a5c0647a11f9 *src/histogram_to_rgbwt.cpp b64ba3d0fb431e86498f0c923dec370e *src/kernel_histogram.cpp 6b33c840bd8d51d3ac3fb77dd70532a5 *src/kernel_rgbwt.cpp 48249f2fe0731c5fd78fc5db27aba42d *src/kernels.h 0fc85d7ae429959a0b9ee3644672ab37 *src/macros.h a945d659900ded0f85b3875169b453f6 *src/scatter_histogram.cpp e424dd74848143f6486456b2ce64f4ee *src/scatter_indexed_rgbwt.cpp 04cc03676fff98a008ea67696678f0a6 *src/scatter_lines_histogram.cpp 7d03297a9976fb5ba7987aba46878aa6 *src/scatter_lines_impl.h f17b6f7cd7ddfa5249646cc569ffc21a *src/scatter_lines_rgbwt.cpp 48ffae9e9833a4968c55d746494a4ff5 *src/scatter_multicolor_rgbwt.cpp 14d1628a9e92d412c71f6db2e64e61df *src/scatter_singlecolor_rgbwt.cpp 82d98cd791fa1dc3fe971f952694f353 *src/scattermore.c 8cc00657dbea8c3c5b9f1bd8f758ec06 *src/scatters.h fcc5bb685512d0f11d65e4d94db1171b *src/scatters_lines.h 0fb3bd4a1e9083dabf898a1b61d6b6a5 *src/thread_blocks.h 26da1d948a42e088d739159ff8f5e63d *tests/testthat.R 0324778179e80e4a0f157608c102962d *tests/testthat/test-geom-methods-basic.R 27435d7cbc1589f2b77cc155c7c3929b *tests/testthat/test-histogram-basic.R 107bdd0a5b4d450bba99f2a6f5a7d203 *tests/testthat/test-histogram-lines-basic.R 8d831930250f73d3664440aff2a62dba *tests/testthat/test-histogram-lines-pixel-overlap.R c1f1ccd2b41781c443fc7e1f715cbf18 *tests/testthat/test-merge-blend-basic.R 526edb7257e715841e1b7c41df037908 *tests/testthat/test-rgbwt-basic.R 823085586d513ec2ab48e31fb2f860c1 *tests/testthat/test-rgbwt-lines-basic.R fab18cfcc5ea409128142cdccdff7293 *tests/testthat/test-rgbwt-raster-transitions-basic.R e2a26981f14b165bcab38ea92c9dd3d9 *tests/testthat/test-scattermoreplot-basic.R 750526982d7535f8ab11f5c0c277985e *vignettes/low_level_interface.Rmd scattermore/inst/0000755000176200001440000000000014441404317013561 5ustar liggesusersscattermore/inst/doc/0000755000176200001440000000000014441404317014326 5ustar liggesusersscattermore/inst/doc/low_level_interface.Rmd0000644000176200001440000003004414441403173021002 0ustar liggesusers--- title: "Low-level scattermore API" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Low-level scattermore API} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup} library(scattermore) set.seed(2023) ``` ```{r, echo=FALSE} # this somehow fails on macs if(Sys.info()["sysname"] != "Darwin") options(bitmapType='cairo') ``` # Low-level interface of Scattermore This vignette gives an overview and comprehensive examples of using the low-level API of `scattermore`. Using the API you can do many more things than just plotting points; mainly `scattermore` supports plotting both 2D-histograms (density plots) and image rasters from both points and lines (and possibly other shapes in the future), modifying and expanding both histograms and image rasters with kernels, and blending all of these using ordering-independent blending methods. The low-level API operates mostly on plain R matrices or arrays; these are formatted in: - integer and floating-point histograms/densities - RGBWT-formatted rasters - floating-point RGBA-formatted rasters with colors "premultiplied" by alpha channel for easier blending - integer RGBA-formatted rasters (without premultiplication) One typically starts with either generating the densities or RGBWT rasters, and successively moves lower in the list towards the usual integer RGBA, which may be e.g. converted to a normal R raster. RGBWT format is specific to `scattermore`, standing for Red Green Blue Weight Transparency. It is similar to a floating-point RGBA with premultiplied alpha: channels R, G, B behave just like in RGBA, channel T is equivalent to (1-A), and channel W (initially equivalent to A) collect the total amount of "paint" that the given pixel has accumulated. With this, blending of layers is guaranteed to be order independent: values in channels RGBW are added together, and values in T are multiplied. To convert RGBWT back to RGBA, one computes A=(1-T), and divides the channels R,G,B by the value of W. ## Plotting data as densities Let us first generate a small random dataset of points and directions: ```{r} n <- 10000 pts <- matrix(rnorm(n*2), n, 2) pts2 <- cbind(5+rnorm(n), -5*rexp(n)) ``` We can convert the density data to an integer density map: ```{r, dev='jpeg'} pdens <- scattermore::scatter_points_histogram(pts, out_size=c(128,128)) par(mar = c(0,0,0,0), bg='white') image(pdens) ``` The same can be done for plotting the densities over the lines: ```{r, dev='jpeg'} ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256)) par(mar = c(0,0,0,0), bg='white') image(ldens) ``` Densities are simple matrices, so in order to improve the visualization you can apply the usual R math functions to their contents: ```{r, dev='jpeg'} ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256)) par(mar = c(0,0,0,0), bg='white') image(log1p(ldens)) ``` ## Plotting data as colored pixels Colored stuff is usually plotted to a 5-channel RGBWT raster format, which eliminates the typical overplotting artifacts. This is later converted to either RGBA or a standard R rasters for plotting. We can plot the points with a single color to the RGBWT format using `scatter_points_rgbwt`. We also show how to fix the precise displayed area using `xlim` and `ylim`. ```{r, dev='jpeg'} # TODO xlim docs rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,3), ylim=c(-3,3)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` You can specify a single color (possibly with alpha channel) for plotting; here we force a lower resolution and turn off pixel interpolation to show the transparency effect more precisely: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb('#8010f010', alpha=T)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ``` The `RGBA` parameter may also assign individual colors to each pixel: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb(rainbow(n, alpha=0.3), alpha=T)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ``` For plotting large clusters that share the colors, arguments `map` and `palette` allow for simpler and more efficient specification of the plotting: ```{r, dev='jpeg'} clusters <- 1 + (pts[,1] < 0) + 2 * (pts[,2] < 0) rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), palette=col2rgb(rainbow(4, alpha=0.2), alpha=T), map=clusters) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ``` Colored RGBWT lines are plotted similarly: ```{r, dev='jpeg'} #TODO as.vector rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#8010f005', alpha=T))) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` ## Expanding densities and RGBWT plots Scattermore takes a distinctive approach to plotting points that are larger than a single pixel -- these are not plotted immediately as large, but instead start as single-pixel "centers" and are later expanded using a kernel function. The expansion is faster for plots that contain huge values of individual points, because the "expansion" operations is aggregated for multiple pixels, and the operation is much more computationally regular, giving additional speedups. First, let's increase the resolution of the example from above: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` This is sub-optimal because the pixels are too small; to fix that we can expand them: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.1), alpha=T), map=clusters) rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=10) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` There are also other expansion options (such as `gauss` and `square`). You can also supply your own kernel in order to plot different shapes of pixels: ```{r, dev='jpeg'} rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=1), alpha=T), map=clusters) rgbwt <- apply_kernel_rgbwt(rgbwt, 'own', mask=outer(1:11, 1:11, Vectorize(function(x,y) 1/(x*y)))) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` The same can be applied to line data to get thicker lines (we limit the number of lines for simplicity here): ```{r, dev='jpeg'} rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2)[1:30,], out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#8010f010', alpha=T))) rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=5) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` Gaussian kernels are excellent for smoothing out point and line densities. As the main change, we need to use the histogram-specific kernel function: ```{r, dev='jpeg'} pdens <- scattermore::scatter_points_histogram(pts, out_size=c(256,256), xlim=c(-3,3), ylim=c(-3,3)) pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10) par(mar = c(0,0,0,0), bg='white') image(pdens, col=rainbow(100)) ``` The calculated densities can be trivially used for overlaying the images with contours. (N. B. that the default gaussian kernels are not "balanced" and increase the total weight present in the graphics; you may still supply a unit weight kernel using the `own` parameter.) ```{r, dev='jpeg'} par(mar = c(0,0,0,0), bg='white') image(pdens, col=topo.colors(100)[20:100]) contour(pdens-15, levels=c(-10,0,30), add=T) ``` ## Coloring densities Specific functionality is provided for converting densities to colorized "heat" maps, converting the histogram to RGBWT format. This is useful for later blending with other RGBWT data. ```{r, dev='jpeg'} pdens <- scattermore::scatter_points_histogram(pts, out_size=c(512,512)) pdens <- apply_kernel_histogram(pdens, 'circle', radius=10) rgbwt <- histogram_to_rgbwt(log1p(pdens), col=topo.colors(100)[10:100]) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` ## Merging RGBWT and RGBA layers Functions for blending ("merging") the RGBWT and RGBA layers are available with one substantial difference: - Merging RGBWT layers never causes overplotting. The layers are merged to produce a weighted mean, with neither being "on top". - Merging RGBA layers explicitly covers one layer by the other one, depending on the alpha value. To showcase this functionality, we show the difference between truly merging and overlaying our data. First, it is necessary to manually ensure that the data is plotted at the same bitmap size with the same coordinates: ```{r} rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#ffcc0010', alpha=T))) rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3) ``` We now merge the data as RGBWT, without overplotting either layer. Notably, the `merge_rgbwt` operation is associative and commutative (except for small numerical imperfections). ```{r, dev='jpeg'} rgbwt <- merge_rgbwt(list(rgbwt1, rgbwt2)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` In this case, neither the lines and points is "in foreground", the colors are correctly merged according to the total amount of "ink" applied to each point in the canvas. If blending in RGBA format, the colors will overlay depending on the order. First with lines on top: ```{r, dev='jpeg'} rgbwt <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt1), rgbwt_to_rgba_float(rgbwt2))) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` ...and with points on top: ```{r, dev='jpeg'} rgba <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt2), rgbwt_to_rgba_float(rgbwt1))) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ``` For demonstration, we produce a huge, colorful, truly psychidelic graphics that combines all of the elements: ```{r, dev='jpeg'} # lines rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#fff0c018', alpha=T))) # points rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3) # background density of the line endpoints pdens <- scatter_points_histogram(pts2, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2)) pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10) rgbwt3 <- histogram_to_rgbwt(sqrt(pdens), RGBA=col2rgb(topo.colors(100)[20:100], alpha=T)) rgba <- blend_rgba_float(list( rgbwt_to_rgba_float(merge_rgbwt(list(rgbwt1, rgbwt2))), rgbwt_to_rgba_float(rgbwt3) )) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba)) par(mar=c(2,2,0.5,0.5), bg='white') plot(c(), xlim=c(-3,7), ylim=c(-5,2)) rasterImage(t(rstr), xleft=-3, xright=7, ybottom=-5, ytop=2) # a trick is required to flip the bitmap vertically contour(seq(-3,7,length.out=512), y=seq(-5,2,length.out=512), pdens[,ncol(pdens):1], add=T, levels=c(2,10)) ``` ## Exporting high-quality graphics Running the graphics through the R plotting pipeline may result in losing pixel-perfect details by interpolating to a slightly imprecise raster. One may save RGBA format to PNG graphics directly, which gives pixel-perfect output together with some other properties (such as preserved transparency). ```{r, eval=FALSE} png::writePNG(rgba_float_to_rgba_int(rgba)/255, "myPicture.png") ``` scattermore/inst/doc/low_level_interface.R0000644000176200001440000001666714441404316020500 0ustar liggesusers## ----setup-------------------------------------------------------------------- library(scattermore) set.seed(2023) ## ---- echo=FALSE-------------------------------------------------------------- # this somehow fails on macs if(Sys.info()["sysname"] != "Darwin") options(bitmapType='cairo') ## ----------------------------------------------------------------------------- n <- 10000 pts <- matrix(rnorm(n*2), n, 2) pts2 <- cbind(5+rnorm(n), -5*rexp(n)) ## ---- dev='jpeg'-------------------------------------------------------------- pdens <- scattermore::scatter_points_histogram(pts, out_size=c(128,128)) par(mar = c(0,0,0,0), bg='white') image(pdens) ## ---- dev='jpeg'-------------------------------------------------------------- ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256)) par(mar = c(0,0,0,0), bg='white') image(ldens) ## ---- dev='jpeg'-------------------------------------------------------------- ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256)) par(mar = c(0,0,0,0), bg='white') image(log1p(ldens)) ## ---- dev='jpeg'-------------------------------------------------------------- # TODO xlim docs rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,3), ylim=c(-3,3)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb('#8010f010', alpha=T)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb(rainbow(n, alpha=0.3), alpha=T)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ## ---- dev='jpeg'-------------------------------------------------------------- clusters <- 1 + (pts[,1] < 0) + 2 * (pts[,2] < 0) rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), palette=col2rgb(rainbow(4, alpha=0.2), alpha=T), map=clusters) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr, interpolate=F) ## ---- dev='jpeg'-------------------------------------------------------------- #TODO as.vector rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#8010f005', alpha=T))) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.1), alpha=T), map=clusters) rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=10) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=1), alpha=T), map=clusters) rgbwt <- apply_kernel_rgbwt(rgbwt, 'own', mask=outer(1:11, 1:11, Vectorize(function(x,y) 1/(x*y)))) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2)[1:30,], out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#8010f010', alpha=T))) rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=5) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- pdens <- scattermore::scatter_points_histogram(pts, out_size=c(256,256), xlim=c(-3,3), ylim=c(-3,3)) pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10) par(mar = c(0,0,0,0), bg='white') image(pdens, col=rainbow(100)) ## ---- dev='jpeg'-------------------------------------------------------------- par(mar = c(0,0,0,0), bg='white') image(pdens, col=topo.colors(100)[20:100]) contour(pdens-15, levels=c(-10,0,30), add=T) ## ---- dev='jpeg'-------------------------------------------------------------- pdens <- scattermore::scatter_points_histogram(pts, out_size=c(512,512)) pdens <- apply_kernel_histogram(pdens, 'circle', radius=10) rgbwt <- histogram_to_rgbwt(log1p(pdens), col=topo.colors(100)[10:100]) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ----------------------------------------------------------------------------- rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#ffcc0010', alpha=T))) rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- merge_rgbwt(list(rgbwt1, rgbwt2)) rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgbwt <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt1), rgbwt_to_rgba_float(rgbwt2))) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgbwt)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- rgba <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt2), rgbwt_to_rgba_float(rgbwt1))) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba)) par(mar=c(0,0,0,0), bg='white') plot(rstr) ## ---- dev='jpeg'-------------------------------------------------------------- # lines rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), RGBA=as.vector(col2rgb('#fff0c018', alpha=T))) # points rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters) rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3) # background density of the line endpoints pdens <- scatter_points_histogram(pts2, out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2)) pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10) rgbwt3 <- histogram_to_rgbwt(sqrt(pdens), RGBA=col2rgb(topo.colors(100)[20:100], alpha=T)) rgba <- blend_rgba_float(list( rgbwt_to_rgba_float(merge_rgbwt(list(rgbwt1, rgbwt2))), rgbwt_to_rgba_float(rgbwt3) )) rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba)) par(mar=c(2,2,0.5,0.5), bg='white') plot(c(), xlim=c(-3,7), ylim=c(-5,2)) rasterImage(t(rstr), xleft=-3, xright=7, ybottom=-5, ytop=2) # a trick is required to flip the bitmap vertically contour(seq(-3,7,length.out=512), y=seq(-5,2,length.out=512), pdens[,ncol(pdens):1], add=T, levels=c(2,10)) ## ---- eval=FALSE-------------------------------------------------------------- # png::writePNG(rgba_float_to_rgba_int(rgba)/255, "myPicture.png") scattermore/inst/doc/low_level_interface.html0000644000176200001440000131653314441404317021240 0ustar liggesusers Low-level scattermore API

Low-level scattermore API

library(scattermore)
set.seed(2023)

Low-level interface of Scattermore

This vignette gives an overview and comprehensive examples of using the low-level API of scattermore. Using the API you can do many more things than just plotting points; mainly scattermore supports plotting both 2D-histograms (density plots) and image rasters from both points and lines (and possibly other shapes in the future), modifying and expanding both histograms and image rasters with kernels, and blending all of these using ordering-independent blending methods.

The low-level API operates mostly on plain R matrices or arrays; these are formatted in:

  • integer and floating-point histograms/densities
  • RGBWT-formatted rasters
  • floating-point RGBA-formatted rasters with colors “premultiplied” by alpha channel for easier blending
  • integer RGBA-formatted rasters (without premultiplication)

One typically starts with either generating the densities or RGBWT rasters, and successively moves lower in the list towards the usual integer RGBA, which may be e.g. converted to a normal R raster.

RGBWT format is specific to scattermore, standing for Red Green Blue Weight Transparency. It is similar to a floating-point RGBA with premultiplied alpha: channels R, G, B behave just like in RGBA, channel T is equivalent to (1-A), and channel W (initially equivalent to A) collect the total amount of “paint” that the given pixel has accumulated. With this, blending of layers is guaranteed to be order independent: values in channels RGBW are added together, and values in T are multiplied. To convert RGBWT back to RGBA, one computes A=(1-T), and divides the channels R,G,B by the value of W.

Plotting data as densities

Let us first generate a small random dataset of points and directions:

n <- 10000
pts <- matrix(rnorm(n*2), n, 2)
pts2 <- cbind(5+rnorm(n), -5*rexp(n))

We can convert the density data to an integer density map:

pdens <- scattermore::scatter_points_histogram(pts, out_size=c(128,128))

par(mar = c(0,0,0,0), bg='white')
image(pdens)

The same can be done for plotting the densities over the lines:

ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256))

par(mar = c(0,0,0,0), bg='white')
image(ldens)

Densities are simple matrices, so in order to improve the visualization you can apply the usual R math functions to their contents:

ldens <- scattermore::scatter_lines_histogram(cbind(pts, pts2), out_size=c(256,256))

par(mar = c(0,0,0,0), bg='white')
image(log1p(ldens))

Plotting data as colored pixels

Colored stuff is usually plotted to a 5-channel RGBWT raster format, which eliminates the typical overplotting artifacts. This is later converted to either RGBA or a standard R rasters for plotting.

We can plot the points with a single color to the RGBWT format using scatter_points_rgbwt. We also show how to fix the precise displayed area using xlim and ylim.

# TODO xlim docs
rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), xlim=c(-3,3), ylim=c(-3,3))
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

You can specify a single color (possibly with alpha channel) for plotting; here we force a lower resolution and turn off pixel interpolation to show the transparency effect more precisely:

rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb('#8010f010', alpha=T))
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr, interpolate=F)

The RGBA parameter may also assign individual colors to each pixel:

rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), RGBA=col2rgb(rainbow(n, alpha=0.3), alpha=T))
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr, interpolate=F)

For plotting large clusters that share the colors, arguments map and palette allow for simpler and more efficient specification of the plotting:

clusters <- 1 + (pts[,1] < 0) + 2 * (pts[,2] < 0)
rgbwt <- scatter_points_rgbwt(pts, out_size=c(128,128), palette=col2rgb(rainbow(4, alpha=0.2), alpha=T), map=clusters)
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr, interpolate=F)

Colored RGBWT lines are plotted similarly:

#TODO as.vector
rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512),
    xlim=c(-3,7), ylim=c(-5,2),
    RGBA=as.vector(col2rgb('#8010f005', alpha=T)))
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

Expanding densities and RGBWT plots

Scattermore takes a distinctive approach to plotting points that are larger than a single pixel – these are not plotted immediately as large, but instead start as single-pixel “centers” and are later expanded using a kernel function. The expansion is faster for plots that contain huge values of individual points, because the “expansion” operations is aggregated for multiple pixels, and the operation is much more computationally regular, giving additional speedups.

First, let’s increase the resolution of the example from above:

rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters)
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

This is sub-optimal because the pixels are too small; to fix that we can expand them:

rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=0.1), alpha=T), map=clusters)
rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=10)
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

There are also other expansion options (such as gauss and square). You can also supply your own kernel in order to plot different shapes of pixels:

rgbwt <- scatter_points_rgbwt(pts, out_size=c(512,512), palette=col2rgb(rainbow(4, alpha=1), alpha=T), map=clusters)
rgbwt <- apply_kernel_rgbwt(rgbwt, 'own',
    mask=outer(1:11, 1:11, Vectorize(function(x,y) 1/(x*y))))
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

The same can be applied to line data to get thicker lines (we limit the number of lines for simplicity here):

rgbwt <- scatter_lines_rgbwt(cbind(pts, pts2)[1:30,], out_size=c(512,512),
    xlim=c(-3,7), ylim=c(-5,2),
    RGBA=as.vector(col2rgb('#8010f010', alpha=T)))
rgbwt <- apply_kernel_rgbwt(rgbwt, 'circle', radius=5)
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

Gaussian kernels are excellent for smoothing out point and line densities. As the main change, we need to use the histogram-specific kernel function:

pdens <- scattermore::scatter_points_histogram(pts, out_size=c(256,256), xlim=c(-3,3), ylim=c(-3,3))
pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10)

par(mar = c(0,0,0,0), bg='white')
image(pdens, col=rainbow(100))

The calculated densities can be trivially used for overlaying the images with contours. (N. B. that the default gaussian kernels are not “balanced” and increase the total weight present in the graphics; you may still supply a unit weight kernel using the own parameter.)

par(mar = c(0,0,0,0), bg='white')
image(pdens, col=topo.colors(100)[20:100])
contour(pdens-15, levels=c(-10,0,30), add=T)

Coloring densities

Specific functionality is provided for converting densities to colorized “heat” maps, converting the histogram to RGBWT format. This is useful for later blending with other RGBWT data.

pdens <- scattermore::scatter_points_histogram(pts, out_size=c(512,512))
pdens <- apply_kernel_histogram(pdens, 'circle', radius=10)
rgbwt <- histogram_to_rgbwt(log1p(pdens), col=topo.colors(100)[10:100])
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

Merging RGBWT and RGBA layers

Functions for blending (“merging”) the RGBWT and RGBA layers are available with one substantial difference: - Merging RGBWT layers never causes overplotting. The layers are merged to produce a weighted mean, with neither being “on top”. - Merging RGBA layers explicitly covers one layer by the other one, depending on the alpha value.

To showcase this functionality, we show the difference between truly merging and overlaying our data. First, it is necessary to manually ensure that the data is plotted at the same bitmap size with the same coordinates:

rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2), out_size=c(512,512),
    xlim=c(-3,7), ylim=c(-5,2),
    RGBA=as.vector(col2rgb('#ffcc0010', alpha=T)))

rgbwt2 <- scatter_points_rgbwt(pts, out_size=c(512,512),
    xlim=c(-3,7), ylim=c(-5,2),
    palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters)
rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3)

We now merge the data as RGBWT, without overplotting either layer. Notably, the merge_rgbwt operation is associative and commutative (except for small numerical imperfections).

rgbwt <- merge_rgbwt(list(rgbwt1, rgbwt2))
rstr <- rgba_int_to_raster(rgbwt_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

In this case, neither the lines and points is “in foreground”, the colors are correctly merged according to the total amount of “ink” applied to each point in the canvas.

If blending in RGBA format, the colors will overlay depending on the order. First with lines on top:

rgbwt <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt1), rgbwt_to_rgba_float(rgbwt2)))
rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgbwt))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

…and with points on top:

rgba <- blend_rgba_float(list(rgbwt_to_rgba_float(rgbwt2), rgbwt_to_rgba_float(rgbwt1)))
rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba))

par(mar=c(0,0,0,0), bg='white')
plot(rstr)

For demonstration, we produce a huge, colorful, truly psychidelic graphics that combines all of the elements:

# lines
rgbwt1 <- scatter_lines_rgbwt(cbind(pts, pts2),
    out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2),
    RGBA=as.vector(col2rgb('#fff0c018', alpha=T)))

# points
rgbwt2 <- scatter_points_rgbwt(pts,
    out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2),
    palette=col2rgb(rainbow(4, alpha=0.5), alpha=T), map=clusters)
rgbwt2 <- apply_kernel_rgbwt(rgbwt2, 'circle', radius=3)

# background density of the line endpoints
pdens <- scatter_points_histogram(pts2,
    out_size=c(512,512), xlim=c(-3,7), ylim=c(-5,2))
pdens <- apply_kernel_histogram(pdens, 'gauss', radius=10)
rgbwt3 <- histogram_to_rgbwt(sqrt(pdens), RGBA=col2rgb(topo.colors(100)[20:100], alpha=T))

rgba <- blend_rgba_float(list(
    rgbwt_to_rgba_float(merge_rgbwt(list(rgbwt1, rgbwt2))),
    rgbwt_to_rgba_float(rgbwt3)
))
rstr <- rgba_int_to_raster(rgba_float_to_rgba_int(rgba))

par(mar=c(2,2,0.5,0.5), bg='white')
plot(c(), xlim=c(-3,7), ylim=c(-5,2))
rasterImage(t(rstr), xleft=-3, xright=7, ybottom=-5, ytop=2)
# a trick is required to flip the bitmap vertically
contour(seq(-3,7,length.out=512), y=seq(-5,2,length.out=512), pdens[,ncol(pdens):1], add=T, levels=c(2,10))

Exporting high-quality graphics

Running the graphics through the R plotting pipeline may result in losing pixel-perfect details by interpolating to a slightly imprecise raster. One may save RGBA format to PNG graphics directly, which gives pixel-perfect output together with some other properties (such as preserved transparency).

png::writePNG(rgba_float_to_rgba_int(rgba)/255, "myPicture.png")