SHARE
TWEET

Profile Rainbow in R

a guest Jun 28th, 2015 2,687 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. library('jpeg'); library('png'); library('gplots')
  2. file <- file.choose()
  3. if (length(grep(pattern = '\\.png$', x = file, ignore.case = TRUE)) > 0) {
  4.   imgdat <- readPNG(source = file)
  5. } else if (length(grep(pattern = '\\.jp[e]?g$', x = file, ignore.case = TRUE)) > 0) {
  6.   imgdat <- readJPEG(source = file)
  7. }
  8.  
  9. n <- 6; xlim <- c(0, dim(imgdat)[2]); ylim <- c(0, dim(imgdat)[1])
  10. rb <- paste(col2hex(cname = c('red', 'orange', 'yellow', 'green', 'blue', 'purple')), '77', sep = '')
  11.  
  12. barx <- rep(c(xlim[2], xlim[2], xlim[1], xlim[1]), times = n)
  13. bary <- seq(ylim[2], ylim[1], length.out = n+1)[c(0:1, 1:0) + rep(1:n, each = 4)]
  14. rectcoords <- cbind(matrix(barx, nc = 4, byrow = TRUE), matrix(bary, nc = 4, byrow = TRUE), 1:n)
  15.  
  16. png(filename = 'rainbow_overlay.png', width = xlim[2], height = ylim[2])
  17. par(bty = 'n', mai = rep(0, 4), oma = rep(0, 4), xaxs = 'i', yaxs = 'i')
  18. plot(0, 0, xlim = xlim, ylim = ylim, type = 'n', asp = 1)
  19. rasterImage(image = imgdat, xleft = xlim[1], ybottom = ylim[1], xright = xlim[2], ytop = ylim[2])
  20. apply(rectcoords, MARGIN = 1, FUN = function(x) polygon(x = x[1:4], y = x[5:8], border = NA, col = rb[x[9]]))
  21. dev.off()
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top