suppressPackageStartupMessages({
  library(dplyr)
  library(ggplot2)

  library(mininetpbm)
})

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%"
)

mininetpbm

mininetpbm is a package for writing vectors, matrices and arrays as NETPBM image files i.e. PGM and PPM formats.

Installation

You can install the released version of mininetpbm from github with:

remotes::install_github('coolbutuseless/mininetpbm')

Outputting a 1D vector as a PGM file

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# 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")

Outputting a 3D array as a PPM file

write_pnm(int_arr, "man/figures/mini3.ppm")
system("convert man/figures/mini3.ppm man/figures/mini3.png")

Benchmark

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# 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'
  )


coolbutuseless/mininetpbm documentation built on May 23, 2019, 5:02 a.m.