[Raster-commits] r338 - pkg/raster/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Mar 10 02:49:32 CET 2009


Author: rhijmans
Date: 2009-03-10 02:49:32 +0100 (Tue, 10 Mar 2009)
New Revision: 338

Modified:
   pkg/raster/R/modal.R
Log:


Modified: pkg/raster/R/modal.R
===================================================================
--- pkg/raster/R/modal.R	2009-03-10 01:19:27 UTC (rev 337)
+++ pkg/raster/R/modal.R	2009-03-10 01:49:32 UTC (rev 338)
@@ -13,12 +13,12 @@
 setMethod('modal', signature(x='ANY'), 
 function(x, ..., ties='random', na.rm=FALSE) {
 #partly based on http://wiki.r-project.org/rwiki/doku.php?id=tips:stats-basic:modalvalue
+	
 	if (!ties %in% c('lowest', 'highest', 'NA', 'random')) {
-		stop("ties should be: 'lowest', 'highest', 'NA', or 'random'")
+		stop("the value of 'ties' should be 'lowest', 'highest', 'NA', or 'random'")
 	}
-
-	x <- c(x, ...)
 	
+	x <- c(x, ...)
 	z <- x[!is.na(x)]
 	if (length(z) == 0) { return(NA) 
 	} else if (na.rm == FALSE & length(z) < length(x)) { 
@@ -27,12 +27,19 @@
 		return(z)
 	} else {
 		freq <- table(z)
-		w <- as.numeric(names(freq[max(freq)==freq]))
+		if (is.logical(z)){logic <- TRUE} else {logic <- FALSE}		
+		if (logic) {
+			w <- as.logical(names(freq[max(freq)==freq]))		
+		} else {
+			w <- as.numeric(names(freq[max(freq)==freq]))
+		}
 		if (length(w) > 1) {
 			if (ties == 'lowest') {
 				w <- min(w)
+				if (logic) { w <- as.logical(w) }
 			} else if (ties == 'highest') {
 				w <- max(w)
+				if (logic) { w <- as.logical(w) }
 			} else if (ties == 'NA') {
 				w <- NA
 			} else { # random
@@ -46,28 +53,3 @@
 )
 
 
-
-
-setMethod("modal", signature(x='Raster'),
-	function(x, ..., ties='random', na.rm=FALSE){
-		rasters <- list(...)
-		if (class(x) == 'RasterLayer') {
-			if (length(rasters)==0) { 
-				return(x) 
-			}
-		}
-		rasters <- c(x, rasters)
-		rm(x)
-		for (i in 1:length(rasters)) {
-			if (class(rasters[[i]]) == 'RasterStack') {
-				r <- rasters[[i]]
-				rasters <- rasters[-i]
-				rasters <- c(rasters, unstack(r))
-				rm(r)
-			}
-		}
-		fun <- function(x){modal(x, ties=ties)}
-		return( .summaryRasters(rasters, fun, 'modal', na.rm=na.rm) )
-	}
-)
-



More information about the Raster-commits mailing list