Merge pull request #185 from lawinslow/master

plot_var_compare x-axis fixes

DESCRIPTION

@@ -1,13 +1,13 @@
 Package: glmtools
 Type: Package
 Title: glmtools
-Version: 0.10.2
+Version: 0.10.3
 Date: 2013-09-18
 Authors@R: c( person("Jordan", "Read", role = c("aut","cre"),
     email = "jread@usgs.gov"),
     person("Luke", "Winslow", role = "aut",
     email = "lwinslow@usgs.gov"))
-Description: tools for working with the GLM lake model.
+Description: Tools for working with the GLM lake model.
 License: file LICENSE
 Copyright: This software is in the public domain because it contains materials
     that originally came from the United States Geological Survey, an agency of
@@ -30,3 +30,4 @@ VignetteBuilder: knitr
 BuildVignettes: true
 LazyLoad: yes
 LazyData: yes
+RoxygenNote: 5.0.1

NAMESPACE

@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.1.1): do not edit by hand
+# Generated by roxygen2: do not edit by hand
 
 S3method(print,nml)
 S3method(summary,nml)

R/plot_temp_compare.R

@@ -4,7 +4,7 @@
 #' @param fig_path F if plot to screen, string path if save plot as .png
 #'@param \dots additional arguments passed to \code{\link{resample_to_field}}
 #'
-#'@seealso Internally uses \link{get_temp} and \link{resample_to_field}
+#'@seealso Internally uses \code{\link{plot_var_compare}}, \code{\link{get_temp}} and \code{\link{resample_to_field}}
 #'
 #'@author Luke Winslow
 #'

R/plot_var_compare.R

@@ -15,7 +15,9 @@
 #'nml_file <- file.path(sim_folder, 'glm2.nml')
 #'field_file <- file.path(sim_folder, 'field_data.tsv')
 #'
-#'plot_var_compare(nc_file, field_file, 'temp') ##makes a plot!
+#'run_glm(sim_folder)
+#'
+#'plot_var_compare(nc_file, field_file, 'temp', resample=FALSE) ##makes a plot!
 #'
 #'@importFrom akima interp
 #'@export
@@ -26,11 +28,7 @@ plot_var_compare = function(nc_file, field_file, var_name, fig_path = FALSE, res
     warning('plot_var_compare not implemented for 1D variables')
     return()
   }
-
-  if (!resample){
-    warning('resample = FALSE is not yet supported for this function')
-    return()
-  }
+
   start_par = par(no.readonly = TRUE)
   #Create layout
 
@@ -39,7 +37,12 @@ plot_var_compare = function(nc_file, field_file, var_name, fig_path = FALSE, res
 
 
   data = resample_to_field(nc_file, field_file, ...)
-  model_df <- resample_sim(mod_temp, t_out = unique(data$DateTime))
+  if(resample){
+  	model_df <- resample_sim(mod_temp, t_out = unique(data$DateTime))
+  }else{
+  	model_df = mod_temp
+  }
+
   #Pivot observed into table
 
   x = as.numeric(as.POSIXct(data$DateTime))
@@ -59,10 +62,13 @@ plot_var_compare = function(nc_file, field_file, var_name, fig_path = FALSE, res
   names(obs_df) <- paste('var_',y_out, sep='')
   obs_df <- cbind(data.frame(DateTime=as.POSIXct(x_out, origin='1970-01-01')), obs_df)
 
+  #Use model to define X-axis plotting extent for both graphs
+  xaxis <- get_xaxis(model_df[,1])
+
   y.text = y_out[1]+diff(range(y_out))*0.05 # note, reference will ALWAYS be surface for compare to field data
-  .plot_df_heatmap(obs_df, bar_title = .unit_label(nc_file,var_name), overlays=c(points(x=x,y=y),text(x_out[1],y=y.text,'Observed', pos=4, offset = 1)))
+  .plot_df_heatmap(obs_df, bar_title = .unit_label(nc_file,var_name), overlays=c(points(x=x,y=y),text(x_out[1],y=y.text,'Observed', pos=4, offset = 1)), xaxis=xaxis)
 
-  .plot_df_heatmap(model_df, bar_title = .unit_label(nc_file,var_name), overlays=text(x_out[1],y=y.text,'Modeled', pos=4, offset = 1))
+  .plot_df_heatmap(model_df, bar_title = .unit_label(nc_file,var_name), overlays=text(x_out[1],y=y.text,'Modeled', pos=4, offset = 1), xaxis=xaxis)
 
   par(start_par)#set PAR back to what it started at
   if(is.character(fig_path))

R/timeseries_plots.R

@@ -10,7 +10,7 @@
   .plot_df_heatmap(data, title, num_cells, palette)
 }
 
-.plot_df_heatmap <- function(data, bar_title, num_cells, palette, title_prefix=NULL, overlays=NULL, ...){
+.plot_df_heatmap <- function(data, bar_title, num_cells, palette, title_prefix=NULL, overlays=NULL, xaxis=NULL, ...){
 
   z_out <- rLakeAnalyzer::get.offsets(data)
   reference = ifelse(substr(names(data)[2],1,3) == 'elv', 'bottom', 'surface')
@@ -27,7 +27,10 @@
   colors <- palette(n = length(levels)-1)
   dates <- data[, 1]
   matrix_var <- data.matrix(data[, -1])
-  xaxis <- get_xaxis(dates)
+  if(is.null(xaxis)){
+  	xaxis <- get_xaxis(dates)
+  }
+
   yaxis <- get_yaxis_2D(z_out, reference, prefix=title_prefix)
   plot_layout(xaxis, yaxis, add=T)
   .filled.contour(x = dates, y = z_out, z =matrix_var,

appveyor.yml

@@ -8,7 +8,7 @@ environment:
 init:
   ps: |
         $ErrorActionPreference = "Stop"
-        Invoke-WebRequest http://raw.github.com/jread-usgs/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
+        Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
         Import-Module '..\appveyor-tool.ps1'
 
 install: