>UPDATE: I rejiggered the function to actually now, y’know, do what it says it should do :-)
A friend, we’ll call him _Alen_ put a call out for some function that could take an image and produce a per-row “histogram” along the edge for the number of filled-in points. That requirement eventually scope-creeped to wanting “histograms” on both the edge and bottom. In, essence there was a desire to be able to compare the number of pixels in each row/line to each other.
Now, you’re all like _”Well, you used ggplot to make the image so…”_ Yeah, not so much. They had done some basic charting in D3. And, it turns out, that it would be handy to compare the data between different images since they had different sets of data they were charting in the same place.
I can’t show you their images as they are part of super seekrit research which will eventually solve world hunger and land a family on Mars. But, I _can_ do a minor re-creation. I made a really simple D3 page that draws random lines in a specified color. Like this:
You can view the source of
First, we need to be able to get the image from the `div` into a bitmap so we can do some pixel counting. We’ll use the new `webshot` package for that.
library(webshot) tmppng1 <- tempfile(fileext=".png") webshot("http://rud.is/projects/randomlines.html?linecol=f6743d", file=tmppng1, selector="#vis")
The image that produced looks like this:
To make the “histograms” on the right and bottom, we’ll use the `raster` capabilities in R to let us treat the data like a matrix so we can easily add columns and rows. I made a function (below) that takes in a `png` file and either a list of colors to look for or a list of colors to exclude and the color you want the “histograms” to be drawn in. This way you can just exclude the background and annotation colors or count specific sets of colors. The counting is fueled by `fastmatch` which makes for super-fast comparisons.
#' Make a "row color density" histogram for an image file #' #' Takes a file path to a png and returns displays it with a histogram of #' pixel density #' #' @param img_file path to png file #' @param target_colors,ignore_colors colors to count or ignore. Either one should be #' \code{NULL} or \code{ignore_colors} should be \code{NULL}. Whichever is #' not \code{NULL} should be a vector of hex strings (can be huge vector of #' hex strings as it uses \code{fastmatch}). The alpha channel is thrown away #' if any, so you only need to specify \code{#rrggbb} hex strings #' @param color to use for the density histogram line selective_image_color_histogram <- function(img_file, target_colors=NULL, ignore_colors=c("#ffffff", "#000000"), hist_col="steelblue", plot=TRUE) { require(png) require(grid) require(raster) require(fastmatch) require(gridExtra) "%fmin%" <- function(x, table) { fmatch(x, table, nomatch = 0) > 0 } "%!fmin%" <- function(x, table) { !fmatch(x, table, nomatch = 0) > 0 } if (is.null(target_colors) & is.null(ignore_colors)) { stop("Only one of 'target_colors' or 'ignore_colors' can be 'NULL'", call.=FALSE) } # clean up params target_colors <- tolower(target_colors) ignore_colors <- tolower(ignore_colors) # read in file and convert to usable data structure png_file <- readPNG(img_file) img <- substr(tolower(as.matrix(as.raster(png_file))), 1, 7) if (length(target_colors)==0) { tf_img <- matrix(img %!fmin% ignore_colors, nrow=nrow(img), ncol=ncol(img)) } else { tf_img <- matrix(img %fmin% target_colors, nrow=nrow(img), ncol=ncol(img)) } # count the pixels wvals <- rowSums(tf_img) hvals <- colSums(tf_img) # add a slight right & bottom margin wdth <- max(wvals) + round(0.1*max(wvals)) hght <- max(hvals) + round(0.1*max(hvals)) # create the "histogram" col_mat <- matrix(rep("#ffffff", wdth*nrow(img)), nrow=nrow(img), ncol=wdth) for (row in 1:nrow(img)) { col_mat[row, 1:wvals[row]] <- hist_col } # make bigger image new_img <- cbind(img, col_mat) # create the "histogram" row_mat <- matrix(rep("#ffffff", hght*ncol(new_img)), ncol=ncol(new_img), nrow=hght) for (col in 1:ncol(img)) { row_mat[1:hvals[col], col] <- hist_col } # make a new bigger image and turn it into something we can use with # grid since we can also use it with ggplot this way if we really wanted to # and friends don't let friends use base graphics rg1 <- rasterGrob(rbind(new_img, row_mat)) # if we want to plot it, now is the time if (plot) grid.arrange(rg1) # return a list with each "histogram" return(list(row_hist=wvals, col_hist=hvals)) }
After reading in the `png` as a raster, the function counts up all the specified pixels by row and extends the matrix width-wise. Then it does the same by column and extends the matrix height-wise. Finally, it makes a `rasterGrob` (b/c friends don’t let friends use base graphics) and optionally plots the output. It also returns the counts by row and by column. That will let us compare between images.
Now we can do:
a <- selective_image_color_histogram(tmppng, hist_col="#f6743d", plot=TRUE)
And, make a counterpart image for it:
tmppng2 <- tempfile(fileext=".png") webshot("http://rud.is/projects/randomlines.html?linecol=80b1d4", file=tmppng2, selector="#vis") b <- selective_image_color_histogram(tmppng2, hist_col="#80b1d4", plot=TRUE)
You can definitely visually compare to see which ones had more “activity” in which row(s) (or column(s)) but why not let R do that for you (you’ll probably need to change the font to something boring like `”Helvetica”`)?
library(ggplot2) library(dplyr) gg <- ggplot(data_frame(x=1:length(a$row_hist), diff=a$row_hist - b$row_hist, `A vs B`=factor(sign(diff), levels=c(-1, 0, 1), labels=c("A", "Neutral", "B")))) gg <- gg + geom_segment(aes(x=x, xend=x, y=0, yend=diff, color=`A vs B`)) gg <- gg + scale_x_continuous(expand=c(0,0)) gg <- gg + scale_y_continuous(expand=c(0,0)) gg <- gg + scale_color_manual(values=c("#f6743d", "#2b2b2b", "#80b1d4")) gg <- gg + labs(x="Row", y="Difference") gg <- gg + coord_flip() gg <- gg + ggthemes::theme_tufte(base_family="URW Geometric Semi Bold") gg <- gg + theme(panel.grid=element_line(color="#2b2b2b", size=0.15)) gg <- gg + theme(panel.grid.major.y=element_blank()) gg <- gg + theme(panel.grid.minor=element_blank()) gg <- gg + theme(axis.ticks=element_blank()) gg <- gg + theme(axis.text.y=element_blank()) gg <- gg + theme(axis.title.x=element_text(hjust=0)) gg <- gg + theme(axis.title.y=element_text(hjust=0)) gg
This way, you let the _power of data science_ show you the answer. (The column processing chart is an exercise left to the reader).
The code may only be useful to _Alen_, but it was a fun and quick enough exercise that I thought it might be useful to the broader community.
Poke holes or improve upon it at will and tell me how horrible my code is in the comments (I have not looked to see if I subtracted in the right direction as I’m on solo dad duty for a cpl days and #4 is hungry).
3 Comments
Have you tried imager (http://dahtah.github.io/imager/) for more advanced image processing?
I’ve riffed on this and made my own version (not wrapped up as a function though) using ggExtra::ggMarginal. Thanks for the inspiration (love the blog, BTW).
http://jcarroll.com.au/2016/03/12/image-marginal-histograms/
I’m posting an update in a minute (totally screwed up orientation…a good reminder that I should prbly not try to crank out a function in 15m :-)
2 Trackbacks/Pingbacks
[…] article was first published on R – rud.is, and kindly contributed to […]
[…] follow Bob Rudis' (a.k.a. hrbrmstr's) blog, typically via R-bloggers, and this post caught my eye. Partly because I thought I knew of an existing way to do this. As usual, actually […]