[Raster-commits] r316 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 6 06:04:14 CET 2009
Author: rhijmans
Date: 2009-03-06 06:04:13 +0100 (Fri, 06 Mar 2009)
New Revision: 316
Added:
pkg/raster/R/Compare_Logical.R
pkg/raster/R/cellStats.R
pkg/raster/R/cv.R
pkg/raster/R/generic-helper-functions.R
pkg/raster/R/modal.R
pkg/raster/man/cellStats.Rd
Removed:
pkg/raster/R/cells.R
pkg/raster/R/compare.logical.functions.R
pkg/raster/R/group.generic.functions.R
pkg/raster/R/stats.R
Modified:
pkg/raster/R/get.R
pkg/raster/R/median.R
pkg/raster/R/replacement.R
pkg/raster/R/xyValues.R
pkg/raster/man/Replace-methods.Rd
pkg/raster/man/get.Rd
pkg/raster/man/stats.Rd
pkg/raster/man/xyValues-methods.Rd
Log:
Added: pkg/raster/R/Compare_Logical.R
===================================================================
--- pkg/raster/R/Compare_Logical.R (rev 0)
+++ pkg/raster/R/Compare_Logical.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -0,0 +1,153 @@
+# Authors: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+.getLogicalRowValues <- function(x, r) {
+# need to take care of 'spase'
+ v <- .getRowValues(x, r)
+ v[v!=0] <- 1
+ return(v)
+}
+
+
+.getLogicalValues <- function(x) {
+ v <- .getRasterValues(x)
+ v[v!=0] <- 1
+ return(v)
+}
+
+
+
+setMethod('==', signature(e1='BasicRaster', e2='BasicRaster'),
+ function(e1,e2){
+ cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.05, stopiffalse=FALSE)
+ return(cond)
+ }
+)
+
+
+
+
+setMethod('!=', signature(e1='BasicRaster', e2='BasicRaster'),
+ function(e1,e2){
+ cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.05, stopiffalse=FALSE)
+ return(!cond)
+ }
+)
+
+
+
+setMethod('!', signature(x='RasterLayer'),
+ function(x){
+ if (.CanProcessInMemory(x, 3)) {
+ return(setValues(x, !values(x)))
+ } else {
+ raster <- setRaster(x, filename=tempfile())
+ raster <- setDatatype(raster, 'LOGICAL')
+ for (r in 1:nrow(x)) {
+ raster <- setValues(raster, !.getRowValues(x, r), r)
+ raster <- writeRaster(raster)
+ }
+ return(raster)
+ }
+ }
+)
+
+
+
+setMethod("Compare", signature(e1='RasterLayer', e2='numeric'),
+ function(e1,e2){
+ if (!isTRUE(is.atomic(e2) & length(e2)==1)) {
+ stop('second argument should be a single number')
+ }
+ if (.CanProcessInMemory(e1, 3)) {
+ raster <- setRaster(e1)
+ raster <- setDatatype(raster, datatype='LOGICAL')
+ raster <- setValues(raster, values=callGeneric(.getRasterValues(e1), rep(e2, ncell(e1)) ) )
+ } else {
+ raster <- setRaster(e1, filename=tempfile())
+ raster <- setDatatype(raster, 'LOGICAL')
+ rowrep <- rep(e2, ncol(e1))
+ for (r in 1:nrow(e1)) {
+ raster <- setValues(raster, callGeneric( .getRowValues(e1, r), rowrep ), r)
+ raster <- writeRaster(raster)
+ }
+ }
+ return(raster)
+ }
+)
+
+
+
+setMethod("Compare", signature(e1='numeric', e2='RasterLayer'),
+ function(e1,e2){
+ if (!isTRUE(is.atomic(e1) & length(e1)==1)) {
+ stop('first argument should be a single number')
+ }
+ if (.CanProcessInMemory(e2, 3)) {
+ raster <- setRaster(e2)
+ raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setValues(raster, callGeneric(.getRasterValues(e2), rep(e1, ncell(e2)) ) )
+ } else {
+ raster <- setRaster(e2, filename=tempfile())
+ raster <- setDatatype(raster, 'LOGICAL')
+ rowrep <- rep(e1, ncol(e2))
+ for (r in 1:nrow(e2)) {
+ raster <- setValues(raster, callGeneric( .getRowValues(e2, r), rowrep ), r)
+ raster <- writeRaster(raster)
+ }
+ }
+ return(raster)
+ }
+)
+
+setMethod("Compare", signature(e1='RasterLayer', e2='RasterLayer'),
+ function(e1,e2){
+ cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE)
+ if (!cond) {
+ stop("Cannot compare RasterLayers that have different BasicRaster attributes. See compare()")
+ }
+ if (.CanProcessInMemory(e1, 3)) {
+ raster <- setRaster(e1)
+ raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setValues(raster, callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) )
+ } else {
+ raster <- setRaster(e1, filename=tempfile())
+ raster <- setDatatype(raster, 'LOGICAL')
+ for (r in 1:nrow(e1)) {
+ raster <- setValues(raster, callGeneric( .getRowValues(e1, r), .getRowValues(e2, r) ), r)
+ raster <- writeRaster(raster)
+ }
+ }
+ return(raster)
+ }
+)
+
+
+
+
+
+setMethod("Logic", signature(e1='RasterLayer', e2='RasterLayer'),
+ function(e1, e2){
+ if ( compare(c(e1, e2)) ) {
+ if (.CanProcessInMemory(e1, 3)) {
+ raster <- setRaster(e1)
+ raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setValues(raster, callGeneric(.getLogicalValues(e1), .getLogicalValues(e2)))
+ } else {
+ raster <- setRaster(e1, filename=tempfile())
+ raster <- setDatatype(raster, 'LOGICAL')
+ for (r in 1:nrow(e1)) {
+ raster <- setValues(raster, callGeneric( .getLogicalRowValues(e1, r), .getLogicalRowValues(e2, r) ), r)
+ raster <- writeRaster(raster)
+ }
+ }
+ return(raster)
+ }
+ }
+)
+
+
Added: pkg/raster/R/cellStats.R
===================================================================
--- pkg/raster/R/cellStats.R (rev 0)
+++ pkg/raster/R/cellStats.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -0,0 +1,41 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+cellStats <- function(x, ..., na.rm=TRUE) {
+ funs <- list(...)
+ if (length(funs) == 0) {
+ stop('you must provide a function as argument')
+ }
+
+ for(i in seq(along=funs)) {
+ if (class(funs[[i]]) != 'function') {
+ stop('only functions are allowed as ... arguments')
+ }
+ }
+
+ res <- list()
+ if (dataContent(x) != 'all') {
+ if (dataSource(x) == 'ram') {
+ stop('no values associated with this RasterLayer')
+ }
+ if (.CanProcessInMemory(x, 2)) {
+ x <- readAll(x)
+ }
+ }
+ if (dataContent(x) == 'all') {
+ for(i in seq(along=funs)) {
+ if (na.rm) {
+ res[i] <- funs[[i]](na.omit(x at data@values))
+ } else {
+ res[i] <- funs[[i]](x at data@values)
+ }
+ }
+ } else {
+ stop('sorry, only implemented for rasters that can be loaded into memory')
+ }
+ return(unlist(res))
+}
+
Deleted: pkg/raster/R/cells.R
===================================================================
--- pkg/raster/R/cells.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/cells.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -1,30 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0.8
-# Licence GPL v3
-
-
-cells <- function(x, ...) {
- funs <- list(...)
- if (length(funs) == 0) {
- return(NULL)
- }
- res <- list()
- if (dataContent(x) != 'all') {
- if (dataSource(x) == 'ram') {
- stop('no values associated with this RasterLayer')
- }
- if (.CanProcessInMemory(x, 2)) {
- x <- readAll(x)
- }
- }
- if (dataContent(x) == 'all') {
- for(i in seq(along=funs)) {
- res[i] <- funs[[i]](x at data@values)
- }
- } else {
- stop('sorry, only implemented for rasters that can be loaded into memory')
- }
-}
-
Deleted: pkg/raster/R/compare.logical.functions.R
===================================================================
--- pkg/raster/R/compare.logical.functions.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/compare.logical.functions.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -1,153 +0,0 @@
-# Authors: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : January 2009
-# Version 0.8
-# Licence GPL v3
-
-
-.getLogicalRowValues <- function(x, r) {
-# need to take care of 'spase'
- v <- .getRowValues(x, r)
- v[v!=0] <- 1
- return(v)
-}
-
-
-.getLogicalValues <- function(x) {
- v <- .getRasterValues(x)
- v[v!=0] <- 1
- return(v)
-}
-
-
-
-setMethod('==', signature(e1='BasicRaster', e2='BasicRaster'),
- function(e1,e2){
- cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.05, stopiffalse=FALSE)
- return(cond)
- }
-)
-
-
-
-
-setMethod('!=', signature(e1='BasicRaster', e2='BasicRaster'),
- function(e1,e2){
- cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.05, stopiffalse=FALSE)
- return(!cond)
- }
-)
-
-
-
-setMethod('!', signature(x='RasterLayer'),
- function(x){
- if (.CanProcessInMemory(x, 3)) {
- return(setValues(x, !values(x)))
- } else {
- raster <- setRaster(x, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
- for (r in 1:nrow(x)) {
- raster <- setValues(raster, !.getRowValues(x, r), r)
- raster <- writeRaster(raster)
- }
- return(raster)
- }
- }
-)
-
-
-
-setMethod("Compare", signature(e1='RasterLayer', e2='numeric'),
- function(e1,e2){
- if (!isTRUE(is.atomic(e2) & length(e2)==1)) {
- stop('second argument should be a single number')
- }
- if (.CanProcessInMemory(e1, 3)) {
- raster <- setRaster(e1)
- raster <- setDatatype(raster, datatype='LOGICAL')
- raster <- setValues(raster, values=callGeneric(.getRasterValues(e1), rep(e2, ncell(e1)) ) )
- } else {
- raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
- rowrep <- rep(e2, ncol(e1))
- for (r in 1:nrow(e1)) {
- raster <- setValues(raster, callGeneric( .getRowValues(e1, r), rowrep ), r)
- raster <- writeRaster(raster)
- }
- }
- return(raster)
- }
-)
-
-
-
-setMethod("Compare", signature(e1='numeric', e2='RasterLayer'),
- function(e1,e2){
- if (!isTRUE(is.atomic(e1) & length(e1)==1)) {
- stop('first argument should be a single number')
- }
- if (.CanProcessInMemory(e2, 3)) {
- raster <- setRaster(e2)
- raster <- setDatatype(raster, 'LOGICAL')
- raster <- setValues(raster, callGeneric(.getRasterValues(e2), rep(e1, ncell(e2)) ) )
- } else {
- raster <- setRaster(e2, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
- rowrep <- rep(e1, ncol(e2))
- for (r in 1:nrow(e2)) {
- raster <- setValues(raster, callGeneric( .getRowValues(e2, r), rowrep ), r)
- raster <- writeRaster(raster)
- }
- }
- return(raster)
- }
-)
-
-setMethod("Compare", signature(e1='RasterLayer', e2='RasterLayer'),
- function(e1,e2){
- cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE)
- if (!cond) {
- stop("Cannot compare RasterLayers that have different BasicRaster attributes. See compare()")
- }
- if (.CanProcessInMemory(e1, 3)) {
- raster <- setRaster(e1)
- raster <- setDatatype(raster, 'LOGICAL')
- raster <- setValues(raster, callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) )
- } else {
- raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
- for (r in 1:nrow(e1)) {
- raster <- setValues(raster, callGeneric( .getRowValues(e1, r), .getRowValues(e2, r) ), r)
- raster <- writeRaster(raster)
- }
- }
- return(raster)
- }
-)
-
-
-
-
-
-setMethod("Logic", signature(e1='RasterLayer', e2='RasterLayer'),
- function(e1, e2){
- if ( compare(c(e1, e2)) ) {
- if (.CanProcessInMemory(e1, 3)) {
- raster <- setRaster(e1)
- raster <- setDatatype(raster, 'LOGICAL')
- raster <- setValues(raster, callGeneric(.getLogicalValues(e1), .getLogicalValues(e2)))
- } else {
- raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
- for (r in 1:nrow(e1)) {
- raster <- setValues(raster, callGeneric( .getLogicalRowValues(e1, r), .getLogicalRowValues(e2, r) ), r)
- raster <- writeRaster(raster)
- }
- }
- return(raster)
- }
- }
-)
-
-
Added: pkg/raster/R/cv.R
===================================================================
--- pkg/raster/R/cv.R (rev 0)
+++ pkg/raster/R/cv.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -0,0 +1,62 @@
+# Author: Robert J. Hijmans
+# International Rice Research Institute
+# contact: r.hijmans at gmail.com
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+setGeneric("cv", function(x, ..., aszero=FALSE, na.rm=FALSE)
+ standardGeneric("cv"))
+
+
+setMethod('cv', signature(x='ANY'),
+function(x, ..., aszero=FALSE, na.rm=FALSE) {
+# R function to compute the coefficient of variation (expressed as a percentage)
+# if there is only a single value, sd = NA. However, one could argue that cv =0.
+# and NA may break the code that receives it.
+#The function returns NA if(aszero=FALSE) else a value of 0 is returned.
+ x <- c(x, ...)
+ z <- x[!is.na(x)]
+ if (length(z) == 0) {
+ return(NA)
+ } else if (na.rm == FALSE & (length(z) < length(x))) {
+ return(NA)
+ } else if (length(z) == 1 & aszero == TRUE) {
+ return(0)
+ } else {
+ x <- mean(z)
+ if (x == 0) {
+ return(NA)
+ } else {
+ return(100 * sd(z) / x)
+ }
+ }
+}
+)
+
+
+setMethod("cv", signature(x='Raster'),
+ function(x, ..., aszero=FALSE, 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, aszero=aszero)}
+ return( .summaryRasters(rasters, fun, 'cv', na.rm=na.rm) )
+ }
+)
+
+
Added: pkg/raster/R/generic-helper-functions.R
===================================================================
--- pkg/raster/R/generic-helper-functions.R (rev 0)
+++ pkg/raster/R/generic-helper-functions.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -0,0 +1,51 @@
+# Authors: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+# helper functions for group generic functions
+
+.getRasterValues <- function(x) {
+# need to take care of 'spase'
+ if (dataContent(x) != 'all') {
+ if (class(x) == "RasterLayer") {
+ if (dataSource(x) == 'ram') {
+ stop('no data on disk or in memory')
+ } else x <- readAll(x)
+ } else {
+ x <- readAll(x)
+ }
+ }
+ return(values(x))
+}
+
+.getRowValues <- function(x, r) {
+# need to take care of 'spase'
+ if (dataContent(x) == 'all') {
+ return(valuesRow(x, r))
+ } else {
+ if (dataSource(x) == 'disk') {
+ return(values(readRow(x, r)))
+ } else {
+ stop('data not on disk or in memory')
+ }
+ }
+}
+
+
+.getAllTypeOfValues <- function(x, y, i) {
+ if ( extends(class(y), "Raster") & compare(c(x, y)) ) {
+ return(.getRasterValues(y))
+ } else if (is.atomic(y)) {
+ return(rep(y, ncell(x)))
+ } else if (length(y)==ncell(x)) {
+ return(y)
+ } else {
+ stop(paste("I do not understand argument",i + 1))
+ }
+}
+
+
+
Modified: pkg/raster/R/get.R
===================================================================
--- pkg/raster/R/get.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/get.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -39,6 +39,21 @@
}
+cellsFromRow <- function(object, rownr) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ cols <- rep(1:ncol(object), times=length(rownr))
+ rows <- rep(rownr, each=length(cols))
+ return(cellFromRowCol(object, rows, cols))
+}
+
+cellsFromCol <- function(object, colnr) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ rows <- rep(1:nrow(object), times=length(colnr))
+ cols <- rep(colnr, each=nrow(object))
+ return(cellFromRowCol(object, rows, cols))
+}
+
+
colFromCell <- function(object, cell) {
if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
cell <- round(cell)
Deleted: pkg/raster/R/group.generic.functions.R
===================================================================
--- pkg/raster/R/group.generic.functions.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/group.generic.functions.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -1,51 +0,0 @@
-# Authors: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : January 2009
-# Version 0.8
-# Licence GPL v3
-
-
-# helper functions for group generic functions
-
-.getRasterValues <- function(x) {
-# need to take care of 'spase'
- if (dataContent(x) != 'all') {
- if (class(x) == "RasterLayer") {
- if (dataSource(x) == 'ram') {
- stop('no data on disk or in memory')
- } else x <- readAll(x)
- } else {
- x <- readAll(x)
- }
- }
- return(values(x))
-}
-
-.getRowValues <- function(x, r) {
-# need to take care of 'spase'
- if (dataContent(x) == 'all') {
- return(valuesRow(x, r))
- } else {
- if (dataSource(x) == 'disk') {
- return(values(readRow(x, r)))
- } else {
- stop('data not on disk or in memory')
- }
- }
-}
-
-
-.getAllTypeOfValues <- function(x, y, i) {
- if ( extends(class(y), "Raster") & compare(c(x, y)) ) {
- return(.getRasterValues(y))
- } else if (is.atomic(y)) {
- return(rep(y, ncell(x)))
- } else if (length(y)==ncell(x)) {
- return(y)
- } else {
- stop(paste("I do not understand argument",i + 1))
- }
-}
-
-
-
Modified: pkg/raster/R/median.R
===================================================================
--- pkg/raster/R/median.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/median.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -4,13 +4,13 @@
# Version 0.8
# Licence GPL v3
-
setGeneric("median", function(x, ..., na.rm=FALSE)
standardGeneric("median"))
setMethod('median', signature(x='ANY'),
- function(x, na.rm=FALSE){
+ function(x, ..., na.rm=FALSE){
+ x <- c(x, ...)
return(stats::median(x, na.rm=na.rm))
}
)
@@ -18,18 +18,14 @@
setMethod("median", signature(x='Raster'),
function(x, ..., 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]]
@@ -38,7 +34,6 @@
rm(r)
}
}
-
return( .summaryRasters(rasters, stats::median, 'median', na.rm=na.rm) )
}
)
Added: pkg/raster/R/modal.R
===================================================================
--- pkg/raster/R/modal.R (rev 0)
+++ pkg/raster/R/modal.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -0,0 +1,73 @@
+# Author: Robert J. Hijmans
+# International Rice Research Institute
+# contact: r.hijmans at gmail.com
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+setGeneric("modal", function(x, ..., ties='random', na.rm=FALSE)
+ standardGeneric("modal"))
+
+
+setMethod('modal', signature(x='ANY'),
+function(x, ..., ties='random', na.rm=TRUE) {
+#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'")
+ }
+
+ x <- c(x, ...)
+
+ z <- x[!is.na(x)]
+ if (length(z) == 0) { return(NA)
+ } else if (na.rm == FALSE & length(z) < length(x)) {
+ return(NA)
+ } else if (length(z) == 1) {
+ return(z)
+ } else {
+ freq <- table(z)
+ w <- as.numeric(names(freq[max(freq)==freq]))
+ if (length(w) > 1) {
+ if (ties == 'lowest') {
+ w <- min(w)
+ } else if (ties == 'highest') {
+ w <- max(w)
+ } else if (ties == 'NA') {
+ w <- NA
+ } else { # random
+ r <- runif(length(w))
+ w <- w[which.max(r)]
+ }
+ }
+ return(w)
+ }
+}
+)
+
+
+
+
+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) )
+ }
+)
+
Modified: pkg/raster/R/replacement.R
===================================================================
--- pkg/raster/R/replacement.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/replacement.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -6,42 +6,62 @@
-
-setMethod("[", "RasterLayer",
- function(x,i,j,...,drop=FALSE) {
- if (!missing(j)) { stop("incorrect number of dimensions") }
-# consider row, sparse....
- if (missing(i)) {
- if (dataContent(x) == 'all') {
- return(values(x))
+setMethod("[", c("RasterLayer","ANY", "ANY"),
+ function(x,i,j,...,drop=TRUE) {
+ if (dataContent(x) != 'all') {
+ if (dataSource(x) != 'disk') {
+ stop('no data associated with this RasterLayer object')
} else {
- if (dataSource(x) != 'disk') {
- stop('no data associated with this RasterLayer object')
- } else {
- return(values(readAll(x)))
- }
- }
+ if (.CanProcessInMemory(x, 1)) {
+ x <- readAll(x)
+ }
+ }
+ }
+
+ argsn <- nargs() - length(list(...)) - !missing(drop)
+ if (dataContent(x) == 'all') {
+ if ( missing(j) && argsn == 2) {
+ callNextMethod( matrix(values(x), nrow(x), ncol(x), byrow=T), i=i, drop=drop )
+ } else {
+ callNextMethod( matrix(values(x), nrow(x), ncol(x), byrow=T), i=i, j=j, drop=drop )
+ }
} else {
- return(cellValues(x, i))
+ if ( missing(j) ) {
+ if ( argsn == 2 ) {
+ return(cellValues(x, i))
+ } else {
+ cells <- cellsFromRow(x, i)
+ return(cellValues(x, cells))
+ }
+ } else if (missing(i)) {
+ cells <- cellsFromCol(x, j)
+ return(cellValues(x, cells))
+ } else {
+ # bound to fail in most cases:
+ cells <- cellFromRowCol(x, i, j)
+ return(cellValues(x, cells))
+ }
}
}
)
-setReplaceMethod("[", "RasterLayer",
+
+
+setReplaceMethod("[", c("RasterLayer","missing", "missing"),
function(x, i, j, value) {
- if (!missing(j)) {
- stop("incorrect number of dimensions")
+ if (length(value) == ncell(x)) {
+ return(setValues(x, value))
+ } else if (length(value) == 1) {
+ return( setValues(x, rep(value, times=ncell(x))) )
+ } else {
+ stop('length of replacement values should be 1 or ncell')
}
- if (missing(i)) {
- if (length(value) == ncell(x)) {
- return(setValues(x, value))
- } else if (length(value) == 1) {
- return( setValues(x, rep(value, times=ncell(x))) )
- } else {
- stop('length of replacement values should be 1 or ncell')
- }
- }
+ }
+)
+
+setReplaceMethod("[", c("RasterLayer","ANY", "missing"),
+ function(x, i, j, value) {
if (class(i) == "RasterLayer") {
i <- as.logical( .getRasterValues(i) )
}
@@ -67,32 +87,6 @@
-#.getColValues <- function(r, colnr) {
-# firstcol <- 1:nrow(r) * ncol(r) - ncol(r)
-# cells <- colnr + firstcol
-# return(values(r)[cells]) }
-
-
-setMethod("[[", c("RasterLayer","ANY","ANY"),
-# i = row
-# j = col
- function(x,i,j,...,drop=FALSE) {
- if (dataContent(x) == 'nodata') {
- if (ncell(x) < 1000000) {
- if (dataSource(x) == 'disk') {
- x <- readAll(x)
- } else {
- stop('no data associated with this RasterLayer object')
- }
- } else {
- stop('Large raster, no data in memory, use readAll() first')
- }
- }
- return( matrix(values(x), nrow(x), ncol(x), byrow=T)[i,j] )
- }
-)
-
-
setReplaceMethod("[[", "RasterLayer",
function(x, i, j, value) {
if (!missing(i)) {
Deleted: pkg/raster/R/stats.R
===================================================================
--- pkg/raster/R/stats.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/stats.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -1,53 +0,0 @@
-# R miscellaneous stat functions
-# Authors: Robert J. Hijmans
-# International Rice Research Institute
-# contact: r.hijmans at gmail.com
-# Date : October 2008
-# Version 0,8
-# Licence GPL v3
-
-
-Mode <- function(x, ties='random', na.rm = TRUE) {
-#partly based on http://wiki.r-project.org/rwiki/doku.php?id=tips:stats-basic:modalvalue
-# ties are broken at random
-# earlier approach contained this
-# freq <- tapply(rep(0, length(x)), x, length)
-# w <- as.vector(which(freq == max(freq)) )
-# result <- as.numeric(dimnames(freq)[[1]][w])
-# return(result)
- z <- x[!is.na(x)]
- if (length(z) == 0) { return(NA)
- } else if (na.rm == FALSE & length(z) < length(x)) { return(NA)
- } else if (length(z) == 1) { return(z)
- } else {
- freq <- table(z)
- w <- as.numeric(names(freq[max(freq)==freq]))
- if (length(w) > 1) {
- if (ties == 'lowest') {
- w <- min(w)
- } else if (ties == 'highest') {
- w <- max(w)
- } else if (ties == 'NA') {
- w <- NA
- } else { # random
- r <- runif(length(w))
- w <- w[which.max(r)]
- }
- }
- return(w)
- }
-}
-
-
-CV <- function(x, na.rm = TRUE, singlevalueaszero=TRUE) {
-# R function to compute the coefficient of variation (expressed as a percentage)
-# if there is only a single value, sd = NA. However, one could argue that cv =0. In this case a NA is returned if(singlevaluecvzero=FALSE)
-# else a value of 0 is returned.
- z <- x[!is.na(x)]
- if (length(z) == 0) { return(NA)
- } else if (na.rm == FALSE & length(z) < length(x)) { return(NA)
- } else if (length(z) == 1 & singlevalueaszero == TRUE) { return(0)
- } else {
- return(100 * sd(z) / mean(z))
- }
-}
Modified: pkg/raster/R/xyValues.R
===================================================================
--- pkg/raster/R/xyValues.R 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/R/xyValues.R 2009-03-06 05:04:13 UTC (rev 316)
@@ -5,50 +5,49 @@
# Version 0.8
# Licence GPL v3
-### xyValues ###
if (!isGeneric("xyValues")) {
- setGeneric("xyValues", function(x, xyCoords)
+ setGeneric("xyValues", function(raster, xyCoords)
standardGeneric("xyValues"))
}
-setMethod("xyValues", signature(x='RasterLayer', xyCoords='matrix'),
- function(x, xyCoords) {
+setMethod("xyValues", signature(raster='RasterLayer', xyCoords='matrix'),
+ function(raster, xyCoords) {
if (dim(xyCoords)[2] != 2) {
stop('xyCoords has wrong dimensions; there should be 2 columns only' )
}
- cells <- cellFromXY(x, xyCoords)
- return(.rasterReadCells(x, cells))
+ cells <- cellFromXY(raster, xyCoords)
+ return(.rasterReadCells(raster, cells))
}
)
-setMethod("xyValues", signature(x='RasterStack', xyCoords='matrix'),
- function(x, xyCoords) {
+setMethod("xyValues", signature(raster='RasterStack', xyCoords='matrix'),
+ function(raster, xyCoords) {
if (dim(xyCoords)[2] != 2) {
stop('xyCoords has wrong dimensions; there should be 2 columns only' )
}
- cells <- cellFromXY(x, xyCoords)
- return(.stackReadCells(x, cells))
+ cells <- cellFromXY(raster, xyCoords)
+ return(.stackReadCells(raster, cells))
}
)
-setMethod("xyValues", signature(x='RasterLayer', xyCoords='SpatialPoints'),
- function(x, xyCoords) {
+setMethod("xyValues", signature(raster='RasterLayer', xyCoords='SpatialPoints'),
+ function(raster, xyCoords) {
xyCoords <- coordinates(xyCoords)
- cells <- cellFromXY(x, xyCoords)
- return(.rasterReadCells(x, cells))
+ cells <- cellFromXY(raster, xyCoords)
+ return(.rasterReadCells(raster, cells))
}
)
-setMethod("xyValues", signature(x='RasterStack', xyCoords='SpatialPoints'),
- function(x, xyCoords) {
+setMethod("xyValues", signature(raster='RasterStack', xyCoords='SpatialPoints'),
+ function(raster, xyCoords) {
xyCoords <- coordinates(xyCoords)
- cells <- cellFromXY(x, xyCoords)
- return(.stackReadCells(x, cells))
+ cells <- cellFromXY(raster, xyCoords)
+ return(.stackReadCells(raster, cells))
}
)
Modified: pkg/raster/man/Replace-methods.Rd
===================================================================
--- pkg/raster/man/Replace-methods.Rd 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/man/Replace-methods.Rd 2009-03-06 05:04:13 UTC (rev 316)
@@ -2,10 +2,13 @@
\docType{methods}
\alias{[,RasterLayer-method}
-\alias{[<-,RasterLayer-method}
+\alias{[,RasterStack-method}
+
+\alias{[<-,RasterLayer,ANY,missing-method}
+\alias{[<-,RasterLayer,missing,missing-method}
+
\alias{[[,RasterLayer,ANY,ANY-method}
\alias{[[<-,RasterLayer,ANY,ANY-method}
-\alias{[,RasterStack-method}
\title{ Replace methods }
@@ -23,9 +26,8 @@
r <- raster(ncol=10, nrow=5)
r[] <- 1:ncell(r) * 2
r[1]
-r[[1,1]]
-r[50]
-r[[5,10]]
+r[,1]
+r[1,]
r[1:10]
r[3:8] <- NA
Added: pkg/raster/man/cellStats.Rd
===================================================================
--- pkg/raster/man/cellStats.Rd (rev 0)
+++ pkg/raster/man/cellStats.Rd 2009-03-06 05:04:13 UTC (rev 316)
@@ -0,0 +1,44 @@
+\name{cellStats}
+
+\alias{cellStats}
+
+\title{Statistics for the cells of a single RasterLayer}
+
+\description{
+ Compute statistics for the cells of a single RasterLayer. In this package, functions such as max, min, mean
+ with one or more RasterLayer objects as argument, will return another RasterLayer. CellStats returns a single value,
+ computed from all the cell values of a single RasterLayer.
+}
+
+\usage{
+cellStats(x, ..., na.rm=TRUE)
+}
+
+\arguments{
+ \item{x}{A vector of numbers (typically integers for mode)}
+ \item{...}{one or more applicable functions}
+ \item{na.rm}{Remove (ignore) NA values}
+}
+
+\value{
+ depends on the function(s) passed as ... argument. Typically a numeric value.
+}
+
+\details{
+valid functions are those that take a numeric vector as argument, and return a single value.
+For example: \code{min}, \code{max}, \code{mean}
+
+This function does not work for very large raster datasets (as all the data need to be loaded into memory).
+}
+
+\seealso{ \code{\link[raster]{setMinMax} } }
+
+\author{Robert J. Hijmans}
+
+\examples{
+r <- raster(nrow=18, ncol=36)
+r[] <- runif(ncell(r)) * 10
+cellStats(r, min, max)
+}
+
+\keyword{univar}
Modified: pkg/raster/man/get.Rd
===================================================================
--- pkg/raster/man/get.Rd 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/man/get.Rd 2009-03-06 05:04:13 UTC (rev 316)
@@ -2,6 +2,8 @@
\alias{colFromCell}
\alias{rowFromCell}
\alias{cellFromRowCol}
+\alias{cellsFromRow}
+\alias{cellsFromCol}
\alias{colFromX}
\alias{rowFromY}
\alias{cellFromXY}
@@ -24,6 +26,8 @@
colFromCell(object, cell)
rowFromCell(object, cell)
cellFromRowCol(object, rownr, colnr)
+cellsFromRow(object, rownr)
+cellsFromCol(object, colnr)
colFromX(object, x)
rowFromY(object, y)
cellFromXY(object, xy)
@@ -42,9 +46,9 @@
\item{x}{x coordinate(s)}
\item{y}{y coordinate(s)}
\item{xy}{matrix of x and y coordinates, or a SpatialPoints or SpatialPointsDataFrame object}
- \item{colnr}{column number(s)}
- \item{rownr}{row number(s)}
- \item{bbox}{A boundinBox object (or an object that can be coerced to a BoundingBox object)}
+ \item{colnr}{column number; or vector of column numbers}
+ \item{rownr}{row number; or vector of row numbers}
+ \item{bbox}{A BoundingBox object (or an object that can be coerced to a BoundingBox object)}
\item{asSpatialPoints}{return a SpatialPoints object (sp package) instead of a matrix}
}
Modified: pkg/raster/man/stats.Rd
===================================================================
--- pkg/raster/man/stats.Rd 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/man/stats.Rd 2009-03-06 05:04:13 UTC (rev 316)
@@ -1,34 +1,45 @@
\name{stats}
-\alias{Mode}
-\alias{CV}
-\title{Miscellaneous statistical functions}
+\alias{modal}
+\alias{modal,ANY-method}
+\alias{modal,Raster-method}
+
+
+\alias{cv}
+\alias{cv,ANY-method}
+\alias{cv,Raster-method}
+
+\title{mode and coefficien of variation}
+
\description{
Miscellanous statistical functions: mode and coefficient of variation
}
+
\usage{
-Mode(x, ties='random', na.rm = TRUE)
-CV(x, na.rm = TRUE, singlevalueaszero=TRUE)
+modal(x, ..., ties='random', na.rm = FALSE)
+cv(x, ..., aszero=FALSE, na.rm = FALSE)
}
+
\arguments{
- \item{x}{A vector of numbers (typically integers for mode)}
+ \item{x}{A vector of numbers (typically integers for modal)}
+ \item{...}{additional (vectors of) numbers}
\item{ties}{character. Indicates how to treat ties. Either 'random', 'lowest', 'highest', or 'NA'}
\item{na.rm}{Remove (ignore) NA values}
- \item{singlevalueaszero}{If \code{TRUE} a zero is returned (rather than an NA) if the mode of single value is computed}
+ \item{aszero}{logical. If \code{TRUE}, a zero is returned (rather than an NA) if the cv of single value is computed}
}
\value{
Mode returns the modal (most frequent) value of a vector of values, ties are broken at random
- CV returns the coefficient of variation (expressed as a percentage). If there is only a single value, sd = NA
- and CV returns NA if singlevaluecvzero=FALSE. However, the default is that cv=0 in this case.
+ cv returns the coefficient of variation (expressed as a percentage). If there is only a single value, \code{sd} is \code{NA}
+ and \code{cv} returns \code{NA} if \code{aszero=FALSE} (the default). However, if (\code{aszero=TRUE}), \code{cv} returns \code{0}.
}
\author{Robert J. Hijmans}
\examples{
- data <- c(0,1,2,3,3,3,3,4,4,4,5,5,6,7,7,8,9,NA)
- Mode(data)
- CV(data)
+data <- c(0,1,2,3,3,3,3,4,4,4,5,5,6,7,7,8,9,NA)
+#modal(data)
+#cv(data)
}
+
\keyword{univar}
-
Modified: pkg/raster/man/xyValues-methods.Rd
===================================================================
--- pkg/raster/man/xyValues-methods.Rd 2009-03-05 14:29:04 UTC (rev 315)
+++ pkg/raster/man/xyValues-methods.Rd 2009-03-06 05:04:13 UTC (rev 316)
@@ -11,15 +11,22 @@
\description{
These methods return values of a RasterLayer or RasterStack for the cells that correspond to the provided xy coordinates (n*2 matrix or SpatialPoints object)
}
+
+\usage{xyValues(raster, xyCoords)}
+
+\arguments{
+\item{raster}{RasterLayer or RasterStack object}
+\item{xyCoords}{xy coordinates (see below, under Methods}
+}
+
\section{Methods}{
\describe{
-\code{xyValues(x, xyCoords)}
+\code{xyCoords} can be a \code{n*2} matrix or dataframe with the first column having the x values, and the second column has the y values.
+It can also be a SpatialPoints* object.
+}
+}
-\item{code{x}}{RasterLayer or RasterStack object}
-\item{code{xyCoords}}{Either a n*2 matrix, first column has the x values, and the second column has the y values; or a SpatialPoints* object.}
-}}
-
\value{
a vector of cell values for a RasterLayer or or a matrix of values for a RasterStack
}
@@ -28,7 +35,6 @@
\author{Robert J. Hijmans }
-
\examples{
#using a new default raster (1 degree global)
r <- raster()
More information about the Raster-commits
mailing list