utils-plot.R

##' @export
to.pdf <- function(expr, filename, ..., verbose=TRUE) {
  if(!file.exists(dirname(filename)))
    dir.create(dirname(filename), recursive=TRUE)
  if ( verbose )
    cat(sprintf("Creating %s\n", filename))
  pdf(filename, ...)
  on.exit(dev.off())
  
  eval.parent(substitute(expr))
}

##' @export
to.dev <- function(expr, dev, filename, ..., verbose=TRUE){
  if(!file.exists(dirname(filename)))
    dir.create(dirname(filename), recursive=TRUE)
  if ( verbose )
    cat(sprintf("Creating %s\n", filename))
  dev(filename, ...)
  on.exit(dev.off())
  eval.parent(substitute(expr))
}

##' @export
na.clean <-function(x){x[!is.na(x)]}

#returns up to 80 unique, nice colors,
#generated using http://tools.medialab.sciences-po.fr/iwanthue/
# Starts repeating after 80
##' @export
niceColors<-function(n=80){
  cols<-rep(c("#75954F","#D455E9","#E34423","#4CAAE1","#451431","#5DE737",
              "#DC9B94","#DC3788","#E0A732","#67D4C1","#5F75E2","#1A3125",
              "#65E689","#A8313C","#8D6F96","#5F3819","#D8CFE4","#BDE640",
              "#DAD799","#D981DD","#61AD34","#B8784B","#892870","#445662",
              "#493670","#3CA374","#E56C7F","#5F978F","#BAE684","#DB732A",
              "#7148A8","#867927","#918C68","#98A730","#DDA5D2","#456C9C",
              "#2B5024","#E4D742","#D3CAB6","#946661","#9B66E3","#AA3BA2",
              "#A98FE1","#9AD3E8","#5F8FE0","#DF3565","#D5AC81","#6AE4AE",
              "#652326","#575640","#2D6659","#26294A","#DA66AB","#E24849",
              "#4A58A3","#9F3A59","#71E764","#CF7A99","#3B7A24","#AA9FA9",
              "#DD39C0","#604458","#C7C568","#98A6DA","#DDAB5F","#96341B",
              "#AED9A8","#55DBE7","#57B15C","#B9E0D5","#638294","#D16F5E",
              "#504E1A","#342724","#64916A","#975EA8","#9D641E","#59A2BB",
              "#7A3660","#64C32A"),
            ceiling(n/80))
  cols[1:n]
}


##' @export
make.transparent <- function(col, opacity=0.5) {
  tmp <- col2rgb(col)/255
  rgb(tmp[1,], tmp[2,], tmp[3,], alpha=opacity)
}

## Position label at a fractional x/y position on a plot
##' @export
label <- function(px, py, lab, ..., adj=c(0, 1)) {
  usr <- par("usr")
  text(usr[1] + px*(usr[2] - usr[1]),
       usr[3] + py*(usr[4] - usr[3]),
       lab, adj=adj, ...)
}

##' @export
is.wholenumber <-  function(x, tol = .Machine$double.eps^0.5)
  abs(x - round(x)) < tol

##' @export