Merge pull request #144 from jread-usgs/master

updates re:issues

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: glmtools
 Type: Package
 Title: glmtools
-Version: 0.7.0
+Version: 0.8.1
 Date: 2013-09-18
 Author: Jordan S Read, Luke A Winslow
 Maintainer: Jordan S Read <jread@usgs.gov>

R/get_var.R

@@ -28,7 +28,7 @@
 #'plot(evaporation)
 #'@import ncdf
 #'@export
-get_var <-  function(file, reference = 'bottom', z_out = NULL, t_out = NULL, var_name, ...){
+get_var <-  function(file,  var_name, reference = 'bottom', z_out = NULL, t_out = NULL, ...){
 
 
 
@@ -39,14 +39,16 @@ get_var <-  function(file, reference = 'bottom', z_out = NULL, t_out = NULL, var
   temp <- get.var.ncdf(glm_nc, var_name)
   time <- get_time(glm_nc)
 
-  if (length(dim(temp)) == 1){
-    # is 1D
+  heatmap <- .is_heatmap(file, var_name)
+
+  if (!heatmap){
     variable_df <- data.frame('DateTime' = time, 'variable' = temp)
     colnames(variable_df)[2] <- var_name
 
     variable_df <- resample_sim(df = variable_df, t_out = t_out, ...)
     return(variable_df)
   }
+
   if (reference!='bottom' & reference!='surface'){
     stop('reference input must be either "surface" or "bottom"')
   }

R/nc_helpers.R

@@ -63,4 +63,12 @@ get_time_info <- function(glm_nc, file = NULL){
 	return(time_info)
 }
 
+.is_heatmap <- function(file, var_name){
+  glm_nc <- get_glm_nc(file)
+  dims <-unlist(lapply(X = var_name, FUN = function(x) length(glm_nc$var[[x]]$dim)))
+
+  close_glm_nc(glm_nc)
+  #dim == 4 is heatmap (3D)
+  return(dims==4 | dims == 0)
+}
 

R/plot_helpers.R

@@ -1,12 +1,17 @@
-gen_default_fig <- function(file_name, fig_w = 4, fig_h = 2, ps = 12, l.mar = 0.35,
-                            r.mar = 0, t.mar = 0.05, b.mar = 0.2, res = 200){
-  png(filename = file_name,
-      width = fig_w, height = fig_h, units = "in", res = res)
-
-
-  par(mai=c(b.mar,0, t.mar, 0),omi=c(0, l.mar, 0, r.mar),ps = ps, mgp = c(1.4,.3,0))
-
-
+gen_default_fig <- function(filename, width = 4, height, ps = 12, res = 200, units = "in",
+                            mai = c(0.2,0,0.05,0),
+                            omi = c(0, 0.35, 0, 0), 
+                            mgp = c(1.4,.3,0),
+                            num_divs = 1, ...){
+
+  if ((is.character(filename))){
+    valid_fig_path(filename)
+    if (missing(height)){
+      height = 2*num_divs
+    }
+    png(filename, width = width, height = height, units = units, res = res)
+  }
+  par(mai = mai,omi = omi, ps = ps, mgp = mgp, ...)
 }
 
 plot_one2one <- function(x, y, ...){
@@ -31,27 +36,12 @@ axis_layout <- function(xaxis, yaxis){
   axis(side = 4, labels=NA, at = yaxis$lim, tck = 0)
 }
 
-get_yaxis <- function(data, title){
-
-  lim <- c(min(data), max(data)*1.1)
-
-
-  rng <- abs(lim[1]-lim[2])
-
-  if (rng < 1){
-    spc <- .25
-  } else if (rng < 2){
-    spc <- .5
-  } else if (rng < 5){
-    spc <- 1
-  } else if (rng < 10){
-    spc <- 2
-  } else {
-    spc <- 5
+get_yaxis <- function(data, title, lim = NULL){
+  if (is.null(lim)){
+    lim <- c(min(data, na.rm = TRUE), max(data, na.rm = TRUE)*1.1)
   }
-
-  start_tck <- floor(min(lim)/spc) * spc
-  ticks <- seq(start_tck, max(lim) + spc, spc)
+
+  ticks <- pretty(data)
   yaxis <- list('lim'=lim, 'ticks'=ticks, 'title' = title)
   return(yaxis) 
 }
@@ -68,41 +58,25 @@ get_yaxis_2D <- function(z_out, reference){
     title <- 'Elevation (m)'
   }
 
-  rng <- abs(lim[1]-lim[2])
-
-  if (rng < 1){
-    spc <- .25
-  } else if (rng < 2){
-    spc <- .5
-  } else if (rng < 5){
-    spc <- 1
-  } else if (rng < 10){
-    spc <- 2
-  } else {
-    spc <- 5
-  }
-  ticks <- seq(0, max(lim) + spc, spc)
-  yaxis <- list('lim'=lim, 'ticks'=ticks, 'title' = title)
+  yaxis <- get_yaxis(data = z_out, title = title, lim = lim)
   return(yaxis) 
 }
 
-color_key <- function(levels, colors, subs, ps, col_label = 'Temperature (\u00B0C)'){
+color_key <- function(levels, colors, subs, cex = 0.75, col_label){
   # add feau plot
   plot(NA, xlim = c(0,1),
        ylim=c(0,1),
        xlab="", ylab="",
        frame=FALSE,axes=F,xaxs="i",yaxs="i")
   old_mgp <- par()$mgp
   old_mai <- par()$mai
-  par(mai=c(old_mai[1],0, old_mai[3], .2), mgp = c(0,0,0))
+  par(mai=c(old_mai[1],0, old_mai[3], .2), mgp = c(0,.25,0))
   axis(side = 4, at = 0.5, tck = NA, labels= col_label, lwd = 0.0)#(\xB0 C)
   spc_pol_rat <- 0.2 # ratio between spaces and bars
 
   p_start <- 0.1
-  p_wid <- 0.35
-  if (missing(ps)){
-    ps <- round(par()$ps*0.7)
-  }
+  p_wid <- 0.55
+
   # plotting to a 1 x 1 space
   if (!all(subs %in% levels)) stop('selected values must be included in levels')
 
@@ -118,9 +92,9 @@ color_key <- function(levels, colors, subs, ps, col_label = 'Temperature (\u00B0
     col <- colors[levels==subs[i]]
     b <- (i-1)*(poly_h+spc_h)
     t <- b+poly_h
-    m <- mean(c(b,t))-0.12*(t-b) # vertical fudge factor for text
+    m <- mean(c(b,t))
     polygon(c(p_start,p_wid,p_wid,p_start),c(b,b,t,t),col = col, border = NA)
-    text(p_wid-.05,m,as.character(subs[i]), ps = ps, pos= 4)
+    text(p_wid+0.025,m,as.character(subs[i]), cex = cex, adj = c(0.5, 1), srt = 90)
   }
   par(mai = old_mai, mgp = old_mgp)
 }
@@ -131,7 +105,7 @@ get_xaxis <- function(dates){
   start_time = min(dates) #earliest date
   end_time = max(dates) #latest date
 
-  vis_time = pretty(dates) # pretty vector to specify tick mark location 
+  vis_time = c(start_time-86400, pretty(dates), end_time+86400) # pretty vector to specify tick mark location 
   sec.end_time = as.numeric(end_time) # show time as seconds
   sec.start_time = as.numeric(start_time) # show time as seconds
   tt = sec.end_time - sec.start_time # time range of data frame; used to specify time axis
@@ -171,12 +145,16 @@ get_xaxis <- function(dates){
   return(list('time_form' = time_form, 'x_lab' = x_lab, 'lim' = c(start_time, end_time), 'vis_time' = vis_time))
 }
 
+.simple_layout <- function(nrow = 1){
+  panels  <- matrix(seq_len(nrow),nrow=nrow)
+  layout(panels)
+}
 
 colbar_layout <- function(nrow = 1){
 	# ensures all colorbar plots use same x scaling for divs
 	mx <- matrix(c(rep(1,5),2),nrow=1)
 	panels <- mx
-	if (nrow > 2){
+	if (nrow > 1){
 		for (i in 2:nrow){
 			panels <- rbind(panels,mx+(i-1)*2)
 		}
@@ -193,7 +171,7 @@ valid_fig_path <- function(fig_path){
   }
 
 }
-plot_layout <- function(xaxis, yaxis, add, data = NA){
+plot_layout <- function(xaxis=NULL, yaxis=NULL, add, data = NA){
 
 	if (!add){
 		panels <- colbar_layout()
@@ -207,3 +185,26 @@ plot_layout <- function(xaxis, yaxis, add, data = NA){
 
 
 }
+
+.stacked_layout <- function(is_heatmap, num_divs){
+  if(num_divs == 1 & !is_heatmap) return()
+
+  if(is_heatmap){
+    colbar_layout(num_divs)
+  } else {
+    .simple_layout(num_divs)
+  }
+
+}
+
+.plot_null <- function(){
+  plot(NA, ylim=c(0,1),xlim=c(0,1), axes=F,ylab="",xlab="")
+}
+
+.unit_label <- function(file, var_name){
+  longname <- sim_var_longname(file, var_name) 
+  titlename <- gsub("(^|[[:space:]])([[:alpha:]])", "\\1\\U\\2", longname, perl=TRUE)
+  units <- sim_var_units(file, var_name)
+  unit_label <- paste0(titlename, " (", units, ")")
+  return(unit_label)
+}

R/plot_temp.R

@@ -1,24 +1,23 @@
 #'@title plot water temperatures from a GLM simulation
 #'@param file a string with the path to the netcdf output from GLM
 #'@param reference a string for 'surface' or 'bottom'
-#'@param num_cells number of vertical cells to use for heatmap
 #'@param fig_path F if plot to screen, string path if save plot as .png
-#'@param add F if create new figure, T if add to existing
+#'@param ... additional arguments passed to \code{par()}
 #'@keywords methods
-#'@seealso \code{\link{get_temp}}
+#'@seealso \code{\link{get_temp}}, \code{\link{plot_var}}
+#'@note
+#'\code{plot_temp} calls \code{\link{plot_var}} specifically for the \code{var_name = 'temp'}. 
+#'\code{\link{plot_var}} uses the \code{\link[graphics]{layout}} function and so is restricted to a full page display.
 #'@author
 #'Jordan S. Read, Luke A. Winslow
 #'@examples 
 #'sim_folder <- run_example_sim(verbose = FALSE)
 #'nc_file <- file.path(sim_folder, 'output.nc')
 #'plot_temp(file = nc_file, fig_path = FALSE)
-#'\dontrun{
-#'plot_temp(file = nc_file, fig_path = '../test_figure.png')
-#'}
+#'plot_temp(file = nc_file, fig_path = 'test_figure.png', height = 3, reference = 'surface')
 #'@export
-plot_temp <- function(file, reference = 'surface', num_cells = 100, fig_path = F, add = F){
+plot_temp <- function(file, fig_path = FALSE, reference = 'surface', ...){
 
-  plot_var(file, var_name = 'temp', col_lim = c(0,36), 
-           reference, num_cells, fig_path, add, bar_title = 'Temperature (\u00B0C)')
+  plot_var(file, var_name = 'temp', fig_path, reference,...)
 
 }