[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