## ---- echo=F, fig.align="center", fig.cap="Eight different species of *Heliconius* butterflies; from @Meyer2006.", out.width="500px"---- knitr::include_graphics("Heliconius_mimicry.jpg") ## ---- echo=F, fig.align="center", fig.cap="The pin is small, but since it's not a part of the butterfly, we should exclude it.", out.width="250px"---- knitr::include_graphics("Heliconius_08_edit.jpg") ## ---- fig.width=5, fig.height=4, fig.align="center", fig.cap="(Note that `plotPixels()` plots a randomly selected subset of the pixels by default in an image to make it easier to see.)"---- Heliconius_08 <- system.file("extdata", "Heliconius/Heliconius_B/Heliconius_08.jpeg", package="colordistance") colordistance::plotPixels(Heliconius_08, lower=NULL, upper=NULL) ## ----------------------------------------------------------------------------- lower <- c(0.99, 0.99, 0.99) upper <- c(1, 1, 1) H8 <- colordistance::loadImage(Heliconius_08, lower=lower, upper=upper) ## ----------------------------------------------------------------------------- names(H8) ## ----------------------------------------------------------------------------- dim(H8$original.rgb) dim(H8$filtered.rgb.2d) ## ---- fig.width=5, fig.height=4, fig.align="center"--------------------------- colordistance::plotPixels(H8) ## ---- fig.width=5, fig.height=4, fig.align="center"--------------------------- lower <- rep(0.8, 3) colordistance::plotPixels(Heliconius_08, lower=lower, upper=upper) ## ----------------------------------------------------------------------------- lower <- rep(0.8, 3) upper <- rep(1, 3) H8 <- colordistance::loadImage(Heliconius_08, lower=lower, upper=upper) dim(H8$filtered.rgb.2d) ## ---- fig.width=5, fig.height=4, fig.align="center", echo=F, fig.cap=""------- pix <- H8$filtered.rgb.2d[sample(nrow(H8$filtered.rgb.2d), 10000), ] colExp <- apply(pix, 1, function(x) rgb(x[1], x[2], x[3])) xlab <- "Red"; ylab <- "Green"; zlab <- "Blue" s3d <- scatterplot3d::scatterplot3d(pix, pch=20, xlim=c(0,1), ylim=c(0,1), zlim=c(0,1), color=colExp, grid = F, xlab=xlab, ylab=ylab, zlab=zlab) a <- 0.5 n <- 3 xy1 <- s3d$xyz.convert(rep(0, n), seq(0, 1, length.out = n), rep(a, n)) xy2 <- s3d$xyz.convert(rep(1, n), seq(0, 1, length.out = n), rep(a, n)) xy3 <- s3d$xyz.convert(seq(0, 1, length.out=n), rep(0, n), rep(a, n)) xy4 <- s3d$xyz.convert(seq(0, 1, length.out=n), rep(1, n), rep(a, n)) yz1 <- s3d$xyz.convert(rep(a, n), rep(0, n), seq(0, 1, length.out=n)) yz2 <- s3d$xyz.convert(rep(a, n), rep(1, n), seq(0, 1, length.out=n)) yz3 <- s3d$xyz.convert(rep(a, n), seq(0, 1, length.out=n), rep(0, n)) yz4 <- s3d$xyz.convert(rep(a, n), seq(0, 1, length.out=n), rep(1, n)) xz1 <- s3d$xyz.convert(rep(0, n), rep(a, n), seq(0, 1, length.out=n)) xz2 <- s3d$xyz.convert(rep(1, n), rep(a, n), seq(0, 1, length.out=n)) xz3 <- s3d$xyz.convert(seq(0, 1, length.out=n), rep(a, n), rep(0, n)) xz4 <- s3d$xyz.convert(seq(0, 1, length.out=n), rep(a, n), rep(1, n)) lty <- "solid" segments(xy1$x, xy1$y, xy2$x, xy2$y, lty=lty) segments(xy3$x, xy3$y, xy4$x, xy4$y, lty=lty) segments(yz1$x, yz1$y, yz2$x, yz2$y, lty=lty) segments(yz3$x, yz3$y, yz4$x, yz4$y, lty=lty) segments(xz1$x, xz1$y, xz2$x, xz2$y, lty=lty) segments(xz3$x, xz3$y, xz4$x, xz4$y, lty=lty) ## ---- fig.width=4, fig.height=3, fig.align="center"--------------------------- # Using 2 bins per channel as in the above figure H8hist <- colordistance::getImageHist(Heliconius_08, bins=c(2, 2, 2), lower=lower, upper=upper) ## ---- fig.align="center", results=F, fig.width=8, fig.height=5---------------- images <- dir(system.file("extdata", "Heliconius/", package="colordistance"), full.names=TRUE) histList <- colordistance::getHistList(images, lower=lower, upper=upper, bins=rep(2, 3), plotting=FALSE, pausing=FALSE) ## ---- fig.align="center", fig.width=7, fig.height=4, echo=F, results=F-------- par(mfrow=c(2,4)) histList <- suppressMessages(colordistance::getHistList(images, lower=lower, upper=upper, bins=rep(2, 3), plotting=TRUE, pausing=FALSE)) ## ----------------------------------------------------------------------------- names(histList) histList$Heliconius_01 ## ----------------------------------------------------------------------------- CDM <- colordistance::getColorDistanceMatrix(histList, method="emd", plotting=FALSE) print(CDM) ## ---- fig.align="center", fig.width=7, fig.height=5, fig.cap="Blue cells indicate **higher** similarity (lower distance), while yellow cells indicate **lower** similarity (higher distance)."---- colordistance::heatmapColorDistance(CDM) ## ---- eval=FALSE-------------------------------------------------------------- # write.csv(CDM, file = "Heliconius_color_distance_matrix.csv") ## ---- fig.align="center", fig.width=8, fig.height=5, eval=FALSE--------------- # # Define upper and lower bounds for background pixels # upper <- rep(1, 3) # lower <- rep(0.8, 3) # # # Get histograms for each image and plot the results # par(mfrow=c(2,4)) # histList <- colordistance::getHistList(images, lower=lower, upper=upper, bins=2) # # # Inspect distance matrix using heatmap # par(mfrow=c(1,1)) # CDM <- colordistance::getColorDistanceMatrix(histList, method="emd", plotting = F) # # # Export distance matrix # write.csv(CDM, file = "./Heliconius_color_distance_matrix.csv") # ## ---- fig.align="center", fig.width=7, fig.height=5, results=F---------------- # Default: histogram binning, EMD color distance metric, 3 bins per channel (27 total) # Note that we get slightly different clustering each time default <- colordistance::imageClusterPipeline(images, upper = upper, lower = lower) # Using k-means instead of histogram kmeansBinning <- colordistance::imageClusterPipeline(images, cluster.method = "kmeans", upper = upper, lower = lower) # Using chisq instead of emd chisq <- colordistance::imageClusterPipeline(images, distance.method = "chisq", upper = upper, lower = lower) # Using HSV instead of RGB hsvPix <- colordistance::imageClusterPipeline(images, color.space = "hsv", upper = upper, lower = lower)