suppressPackageStartupMessages({ library(dplyr) library(ggplot2) library(mininetpbm) }) knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "man/figures/README-", out.width = "100%" )
mininetpbm
is a package for writing vectors, matrices and arrays as NETPBM
image files i.e. PGM and PPM formats.
You can install the released version of mininetpbm from github with:
remotes::install_github('coolbutuseless/mininetpbm')
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Create an integer matrix and integer vector #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ N <- 255 int_vec <- rep.int(seq(N), N) %% 256 int_mat <- matrix(int_vec, N, N, byrow = TRUE) dbl_mat <- int_mat/255 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Create a colourful integer array (RGB) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ r <- int_mat g <- t(int_mat) b <- int_mat[, rev(seq(ncol(int_mat)))] int_arr <- array(c(r, g, b), dim = c(N, N, 3)) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # write the vector as a PGM image file #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ write_pnm(int_mat, "man/figures/mini.pgm")
system("convert man/figures/mini.pgm man/figures/mini.png")
write_pnm(int_arr, "man/figures/mini3.ppm")
system("convert man/figures/mini3.ppm man/figures/mini3.png")
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Setup a test matrix and array to output #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ N <- 255 int_vec <- rep.int(seq(N), N) %% 256L int_mat <- matrix(int_vec, N, N, byrow = TRUE) dbl_mat <- int_mat/255 dbl_arr <- remap_with_viridis(dbl_mat) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Integer matrix saved to image #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ grey_res <- bench::mark( netpbm1 = write_pgm(int_mat, "working/gray1.pgm"), netpbm2 = write_pnm( dbl_mat, 'working/grey.pgm'), png = png::writePNG( dbl_mat, target = 'working/grey.png'), jpeg = jpeg::writeJPEG(dbl_mat, target = 'working/grey.jpg'), check = FALSE ) grey_res plot(grey_res) + theme_bw(15) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Write an RGB integer array to image #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ colour_res <- bench::mark( netpbm = write_pnm( dbl_arr, 'working/colour.ppm'), png = png::writePNG( dbl_arr, target = 'working/colour.png'), jpeg = jpeg::writeJPEG(dbl_arr, target = 'working/colour.jpg'), check = FALSE ) colour_res plot(colour_res) + theme_bw(15)
summary(res) %>% select(expression, mean, median, `itr/sec`, mem_alloc) %>% knitr::kable(caption = "Benchmark results") plot(res) + theme_bw(10) + theme( legend.position = 'bottom' )
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.