The glow
package is a framework for creating plots with
glowing points as an alternative way of plotting large point clouds.
Methylation 450K Volcano Plot | Diamonds |
---|---|
Milky Way Galaxy (6.1 million stars) |
---|
OpenStreetMap GPS traces (2.8 billion points) |
---|
Clifford strange attractor (1 billion points) |
---|
Airline Dataset (145 million points) | Glow-y Spiral |
---|---|
U.S. Coronavirus Cases (2021) |
---|
glow
plots don’t depend on the order of points in the
data (points are commutative and associative)inst/examples/examples.r
)Creating a glow plot is done through the GlowMapper
or
GlowMapper4
classes, which utilize the R6
class framework.
The class function $map
creates a raster that can be
plotted with ggplot
’s geom_raster
or output
directly using the EBImage
library.
See the help files and inst/examples/notes.txt
for more
information on each example.
library(glow)
library(ggplot2)
library(viridisLite) # Magma color scale
# Number of threads
nt <- 4
data(diamonds)
gm <- GlowMapper$new(xdim=800, ydim = 640, blend_mode = "screen", nthreads=nt)
# relx(0.002) makes point size relative to x-axis, e.g. each point radius is 0.2% of the y-axis
gm$map(x=diamonds$carat, y=diamonds$price, intensity=1, radius = rely(0.002))
pd <- gm$output_dataframe(saturation = 1)
# Dark color theme
ggplot() +
geom_raster(data = pd, aes(x = pd$x, y = pd$y, fill = pd$value), show.legend = FALSE) +
scale_fill_gradientn(colors = additive_alpha(magma(12))) +
coord_fixed(gm$aspect(), xlim = gm$xlim(), ylim = gm$ylim()) +
labs(x = "carat", y = "price") +
theme_night(bgcolor = magma(12)[1])
# light "heat" color theme
light_colors <- light_heat_colors(144)
ggplot() +
geom_raster(data = pd, aes(x = pd$x, y = pd$y, fill = pd$value), show.legend = FALSE) +
scale_fill_gradientn(colors = additive_alpha(light_colors)) +
coord_fixed(gm$aspect(), xlim = gm$xlim(), ylim = gm$ylim()) +
labs(x = "carat", y = "price") +
theme_bw(base_size = 14)
# light "cool" color theme
light_colors <- light_cool_colors(144)
ggplot() +
geom_raster(data = pd, aes(x = pd$x, y = pd$y, fill = pd$value), show.legend = FALSE) +
scale_fill_gradientn(colors = additive_alpha(light_colors)) +
coord_fixed(gm$aspect(), xlim = gm$xlim(), ylim = gm$ylim()) +
labs(x = "carat", y = "price") +
theme_bw(base_size = 14)
Instead of using ggplot, you can also output a raster image directly
using the EBImage
Bioconductor library.
library(EBImage)
# Generate data
cliff_points <- clifford_attractor(1e6, 1.886,-2.357,-0.328, 0.918, 0.1, 0)
color_pal <- circular_palette(n=144, pal_function=rainbow)
cliff_points$color <- map_colors(color_pal, cliff_points$angle, min_limit=-pi, max_limit=pi)
# Create raster
gm <- GlowMapper4$new(xdim=480, ydim = 270, blend_mode = "additive", nthreads=4)
gm$map(x=cliff_points$x, y=cliff_points$y, radius=1e-3, color=cliff_points$color)
pd <- gm$output_raw(saturation = 1)
# Output raster with EBImage
image_array <- array(1, dim=c(480, 270, 3))
image_array[,,1] <- pd[[1]]*pd[[4]]
image_array[,,2] <- pd[[2]]*pd[[4]]
image_array[,,3] <- pd[[3]]*pd[[4]]
img <- EBImage::Image(image_array, colormode='Color')
plot(img)
writeImage(img, "plots/clifford_vignette.png")