R/plotUtils.R

In ick003/SpTMixture: Mixture models with spatio-temporal dependencies

#' @export
plotFreq = function(tableTemp, cexT = 1.5){
  par(mar = c(4,4,0,1))
  plot(-2, xlim  = c(0,ncol(tableTemp)+1), ylim  = c(0,nrow(tableTemp)+1),
       xaxt="n", yaxt = "n", xlab="", ylab = "", bty = "n")

  seqTemp = seq(0,max(tableTemp),1)
  tableCol = round(min(4, length(seqTemp)-1)*tableTemp / max(tableTemp)) + 1

  colR = rainbow(min(5, length(seqTemp)))

  if(length(seqTemp) < 5){
    lege.t =seq(0,max(tableTemp),1)[sapply(seq(1,length(seqTemp),1), function(x) min(which(round((length(seqTemp)-1)*seq(0,max(tableTemp),1) / max(tableTemp))+1 == x)))]
    lege.t[which(is.na(lege.t))] <- lege.t[which(is.na(lege.t))-1]
    lege = paste0(c(lege.t[c(1:length(seqTemp))]),c("-"),c(lege.t[2:length(seqTemp)],max(tableTemp)))
  }else{
    lege.t =seq(0,max(tableTemp),1)[sapply(seq(1,5,1), function(x) min(which(round(4*seq(0,max(tableTemp),1) / max(tableTemp))+1 == x)))]
    lege.t[which(is.na(lege.t))] <- lege.t[which(is.na(lege.t))-1]
    lege = paste0(c(lege.t[c(1:5)]),c("-"),c(lege.t[2:5],max(tableTemp)))
  }


  for(i in 1:nrow(tableTemp)){
    idx.pos = which(tableTemp[i,]>0)
    points(idx.pos,rep(i, length(idx.pos)), pch = 15, col = colR[tableCol[i,idx.pos]], cex=cexT)
  }
  axis(1, at = 1:ncol(tableTemp), labels = colnames(tableTemp), las = 2, cex.axis = 0.5)
  axis(2, at = 1:nrow(tableTemp), labels = rownames(tableTemp), las = 1, cex.axis = 0.5)
  legend('top', c("#M: ",lege[!is.na(lege.t)]),col = c("black",colR[!is.na(lege.t)]), pch = c(NA,rep(15,min(length(seqTemp),5))), ncol = min(length(seqTemp),5)+1, bty="n")
}
#' @export
clipToExtent <- function( sp, extent ) {
  require(rgeos)
  keep <- gContains( extent, sp,byid=TRUE ) | gOverlaps( extent, sp,byid=TRUE )
  stopifnot( ncol(keep)==1 )
  sp[drop(keep),]
}
#' @export
asSpatialPolygonsBbox <- function( bbox,
                                   proj4stringFrom=CRS("+proj=longlat +datum=WGS84"),
                                   proj4stringTo=NULL,
                                   type = "GPS",
                                   zoom = 1) {
  # Create unprojected bbox as spatial object
  midpoint = rowMeans(bbox)
  radius = bbox - matrix(rep(c(midpoint),2),ncol = 2)
  newradius = radius * 1 / zoom
  bbox = matrix(rep(c(midpoint),2),ncol = 2) + newradius
  if(type=="GPS"){bboxMat <- rbind( c(bbox['lon','min'],bbox['lat','min']), c(bbox['lon','min'],bbox['lat','max']), c(bbox['lon','max'],bbox['lat','max']), c(bbox['lon','max'],bbox['lat','min']), c(bbox['lon','min'],bbox['lat','min']) )} # clockwise, 5 points to close it
  if(type=="UTM"){bboxMat <- rbind( c(bbox['X','min'],bbox['Y','min']), c(bbox['X','min'],bbox['Y','max']), c(bbox['X','max'],bbox['Y','max']), c(bbox['X','max'],bbox['Y','min']), c(bbox['X','min'],bbox['Y','min']) )}
  bboxSP <- SpatialPolygons( list(Polygons(list(Polygon(bboxMat)),"bbox")), proj4string=proj4stringFrom  )
  if(!is.null(proj4stringTo)) {
    bboxSP <- spTransform( bboxSP, proj4stringTo )
  }
  bboxSP
}
#' @export
plot.multi.dens <- function(s, legend)
{
  junk.x = NULL
  junk.y = NULL
  for(i in 1:length(s)) {
    junk.x = c(junk.x, quantile(density(s[[i]])$x, c(0.01,0.99)))
    junk.y = c(junk.y, density(s[[i]])$y)
  }
  xr <- range(junk.x)
  yr <- range(junk.y)
  plot(density(s[[1]]), xlim = xr, ylim = yr, main = "")
  for(i in 1:length(s)) {
    lines(density(s[[i]]), xlim = xr, ylim = yr, col = i)
  }
  legend("topright", legend = legend, col = 1:length(legend), lty = 1, bty = "n")
}
#' @export
create.list.factors <- function(value,factor){
  factor.lev = unique(factor)
  factor.lev = na.omit(factor.lev)
  ll = NULL
  for(j in factor.lev){
    l.value = value[factor == j]
    l.value = na.omit(l.value)
    ll = c(ll, list(l.value))
  }
  return(ll)
}
#' @export
colorRampAlpha <- function(..., n, alpha) {
  colors <- colorRampPalette(...)(n)
  paste(colors, sprintf("%x", ceiling(255*alpha)), sep="")
}