Commits

Paul Hiemstra committed 37aa3c2

Added an alternative plot for the cross-validation residuals
which uses ggplot as a backend. Much nicer graphics.

  • Participants
  • Parent commits 2a40e65

Comments (0)

Files changed (1)

 
 compare.cv = function(..., col.names, bubbleplots = FALSE, zcol = "residual", 
 						   layout, key.entries, reference = 1, plot.diff = FALSE,
-                           digits = 4) 
+                           digits = 4, ggplot = FALSE, addPoly = NULL) 
 # A function to compare cross-validations to each other in both statistics (using summary.autoKrige.cv) or
 # in bubble plots (using cv.compare.bubble). '...' can be both output from krige.cv or autoKrige.cv.
 {
 			layout2 = unlist(sapply(1:10, function(x) return(rep(x, 2*x))))
 			layout = c(layout1[length(dots)], layout2[length(dots)])
 		}
-		if(missing(key.entries)) key.entries = quantile(dots[[reference]]$krige.cv_output[[zcol]])
-		cv.compare.bubble(dots, zcol = zcol, col.names = col.names, 
-						  layout = layout, key.entries = key.entries, 
-						  reference = reference, plot.diff = plot.diff)
+        if(ggplot) {
+            print(cv.compare.ggplot(dots, zcol = zcol, layout = layout, addPoly = addPoly, col.names = col.names))
+        } else {
+            if(missing(key.entries)) key.entries = quantile(dots[[reference]]$krige.cv_output[[zcol]])
+            cv.compare.bubble(dots, zcol = zcol, col.names = col.names, 
+                              layout = layout, key.entries = key.entries, 
+                              reference = reference, plot.diff = plot.diff)
+        }
 	}	
 
 	return(data.frame(out))
     it = it + 1   
   }
 }
+
+# Same as cv.compare.bubble, only now the plot is made using ggplot
+# instead of lattice. I find this version preferable.
+cv.compare.ggplot = function(objs, zcol = "residual", layout, col.names, addPoly = NULL) {
+  objs = checkIfautokrige.cv(objs)
+  
+  # Build data for ggplot
+  coornames = names(data.frame(coordinates(objs[[1]]$krige.cv_output)))
+  dat = melt(lapply(objs, function(x) {
+      dum = data.frame(x$krige.cv_output)[c(coornames, zcol)]
+      return(dum)
+    }), measure.vars = NULL)
+  zcol_abs = sprintf("%s_abs", zcol)
+  dat[[zcol_abs]] = abs(dat[[zcol]])
+  if(!missing(col.names)) dat$L1 = factor(dat$L1, levels = col.names)
+
+  # Make plot
+  ggobj = ggplot(aes_string(x = coornames[1], y = coornames[2], size = zcol_abs, color = zcol), data = dat) +
+      facet_wrap(~ L1, ncol = layout[1], nrow = layout[2], as.table = TRUE) + 
+      scale_x_continuous(name = "", breaks = NA, labels = NA) + 
+      scale_y_continuous(name = "", breaks = NA, labels = NA) + coord_equal() +
+      scale_color_gradient2("Under- or \noverestimation", high = "green", low = "red", mid = "grey80") + 
+      scale_size_continuous("Amount")
+  if(!is.null(addPoly)) {
+    require(gpclib)
+    require(maptools)
+    if(!is.data.frame(addPoly)) addPoly = fortify(addPoly) else stop("addPoly should be SpatialPointsDataFrame")
+    addPoly[[zcol]] = min(dat[[zcol]])
+    addPoly[[zcol_abs]] = min(dat[[zcol_abs]])
+    ggobj = ggobj + geom_path(aes(x = long, y = lat, group = group), color = "lightgrey", size = 0.5, data = addPoly, legend = FALSE)
+  }
+  return(ggobj + geom_point())
+}
+
+
+
+
+
+
+
+