#!/usr/bin/Rscript datafile <- "images.csv"; outdir <- "stats"; imgsize <- 800; # Packages if (!require("plyr")) install.packages("plyr"); library("plyr"); if (!require("colorRamps")) install.packages("colorRamps"); library("colorRamps") # Color scheme heatramp <- blue2green2red(100); # Wrap text wrap <- function(x,len) paste(strwrap(x, width=14), collapse="\n"); # Generate axes for plot matrix.axes <- function(data, xvals, yvals, xlabels, ylabels) { # Analyse col/row ranges x <- as.numeric(as.vector(rownames(data))); y <- as.numeric(as.vector(colnames(data))); # Displayed label values xl <- sort(unique(xvals)); yl <- sort(unique(yvals)); # Values (transfer) xl <- xl[xl>0]; yl <- yl[yl>0]; xv <- log10(xl); yv <- log10(yl); # Positions for displayed labels xp <- (xv - min(xv)) / (max(xv) - min(xv)); yp <- (yv - min(yv)) / (max(yv) - min(yv)); # Draw axes axis(side=1, at=xp, labels=lapply(lapply(xl, xlabels), wrap), las=2); axis(side=2, at=yp, labels=lapply(lapply(yl, ylabels), wrap), las=2); return(FALSE); } # Square of x, length of vector sqr <- function(x) x*x; norm <- function(x) sqrt(sum(sapply(x, sqr))); # Create density matrix density <- function(Xval, Yval, n, z.rm=FALSE, sd=0.02) { # Convolution kernel kernel <- function(val) dnorm(val, mean=0, sd=sd); # Data matrix xy <- matrix(0, length(Xval), 2); xy[,1] <- as.vector(Xval); xy[,2] <- as.vector(Yval); xy <- xy[!rowSums(is.na(xy)),]; if (z.rm) xy <- xy[!apply(xy, 1, function(r) any(0 %in% r)),]; xy.mean <- apply(xy, 2, mean); xy.sd <- apply(xy, 2, sd); xy.min <- apply(xy, 2, min); xy.max <- apply(xy, 2, max); xy.range <- xy.max - xy.min; # v: normalized x-y values v <- xy; # Translates ij indices to xy values ij.to.xy <- matrix(0, n + 1, 2); # Translates ij indices to normalized xy values ij.to.v <- matrix(0, n + 1, 2); # Transfer xyl <- log10(xy); xyl.min <- apply(xyl, 2, min); xyl.max <- apply(xyl, 2, max); xyl.range <- xyl.max - xyl.min; # Calculate for (k in 1:2) { v[,k] <- (xyl[,k] - xyl.min[k]) / xyl.range[k]; ij.to.xy[,k] <- seq(from=xy.min[k], to=xy.max[k], length=n+1); ij.to.v[,k] <- seq(from=0, to=1, length=n+1); } # Convolve and calculate pixel intensities d <- matrix(0, n + 1, n + 1, dimnames=list(0:n, 0:n)); pb <- txtProgressBar(0, n + 1); for (i in 0:n + 1) { for (j in 0:n + 1) { d[i, j] <- sqrt(sum(apply(v, 1, function(q) kernel(norm(c(ij.to.v[i,1], ij.to.v[j,2]) - q))))); } setTxtProgressBar(pb, i); } close(pb); # Set row/col names i <- 0:n + 1; j <- 0:n + 1; colnames(d)[i] <- ij.to.xy[i,1]; rownames(d)[j] <- ij.to.xy[j,2]; return(d); }; # Color bar color.bar <- function(lut, low, high) { par(mar=c(4, 2, 2, 4)); plot.new(); axis(4, at=0:1, labels=c(low, high), las=2); scale <- length(lut) - 1; for (i in 1:scale) { y <- (i - 1) / scale; rect(0, y, 20, y + 1 / scale, col=lut[i], border=NA); } }; # Convert human text to field name tofield <- function(s) { w <- strsplit(s, " ")[[1]]; res <- paste(toupper(substring(w, 1, 1)), substring(w, 2), sep='', collapse=''); return(res); }; # Generate heatmap and save to /2d--.png heat <- function(data, Xname, Yname, xlabels=function(x) x, ylabels=function(x) x, sd=0.04, quality=400) { print(paste("Rendering", Xname, "vs.", Yname)); x <- tofield(Xname); y <- tofield(Yname); d <- density(data[[x]], data[[y]], n=quality, z.rm=TRUE, sd=sd); cross <- xtabs(freq~., count(data, c(x, y))); png(paste0(outdir, "/", paste("2d", x, y, sep="-"), '.png'), units="px", width=imgsize, height=imgsize, pointsize=10); par(oma=c(0,0,0,0)); layout(matrix(c(1,2), 2, 2, byrow=TRUE), width=c(7, 1), height=c(1)); par(mar=c(6,6,4,1)); image( d, axes=matrix.axes(d, data[[x]], data[[y]], xlabels, ylabels), col=heatramp, main=paste("Correlation between", tolower(Xname), "and", tolower(Yname), sep=" "), cex.main=1.8, ); mtext(side=1, Xname, line=4, cex=1.5); mtext(side=2, Yname, line=4, cex=1.5); color.bar(heatramp, "Rare", "Often"); dev.off(); }; # Label formatting shutterfrac <- function(speed) { s = as.numeric(speed); if (s < 1) { return(paste0("1/", signif(1 / s, 2))); } else { return(paste0(signif(s, 2), '"')); } } aper <- function(num) paste0("f/", num); milli <- function(num) paste0(num, "mm"); # Load data data <- read.csv(datafile); # Plot! heat(data, 'Aperture', 'Focal length', xlabels=aper, ylabels=milli); heat(data, 'Aperture', 'Shutter speed', xlabels=aper, ylabels=shutterfrac); heat(data, 'Shutter speed', 'Focal length', xlabels=shutterfrac, ylabels=milli); heat(data, 'Focal length', 'ISO', xlabels=milli);