[Raster-commits] r289 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 22 06:54:40 CET 2009
Author: rhijmans
Date: 2009-02-22 06:54:40 +0100 (Sun, 22 Feb 2009)
New Revision: 289
Added:
pkg/raster/R/alignBbox.R
pkg/raster/R/isLatLon.R
pkg/raster/R/layers.R
pkg/raster/R/ncell.R
pkg/raster/R/summary.R
pkg/raster/R/summary.methods.R
Modified:
pkg/raster/DESCRIPTION
pkg/raster/NAMESPACE
pkg/raster/R/Merge.R
pkg/raster/R/bboxUnion.R
pkg/raster/R/crop.R
pkg/raster/R/distance.R
pkg/raster/R/group.generic.functions.R
pkg/raster/R/properties.R
pkg/raster/R/rasterToPoints.R
pkg/raster/R/setBbox.R
pkg/raster/R/standard.generic.functions.R
pkg/raster/man/Summary-methods.Rd
pkg/raster/man/bbox.Rd
pkg/raster/man/properties.Rd
pkg/raster/man/rasterToPoints.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/DESCRIPTION 2009-02-22 05:54:40 UTC (rev 289)
@@ -1,7 +1,7 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.8-5
+Version: 0.8.8-6
Date: 22-Feb-2009
Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
Author: Robert J. Hijmans & Jacob van Etten
Modified: pkg/raster/NAMESPACE
===================================================================
--- pkg/raster/NAMESPACE 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/NAMESPACE 2009-02-22 05:54:40 UTC (rev 289)
@@ -1,8 +1,8 @@
-importFrom("methods", Arith, Compare, Logic, Math)
+importFrom("methods", Ops, Math)
importFrom("graphics", hist, plot)
importFrom("stats", median, aggregate)
importFrom("utils", stack)
importFrom("sp", overlay, bbox, Spatial, SpatialPixels, SpatialPixelsDataFrame, SpatialGrid, SpatialGridDataFrame)
exportClasses(BoundingBox, BasicRaster, Raster, RasterLayer, RasterStack)
-exportMethods(calc, overlay, bbox, aggregate, stack, median, show, summary, plot, hist, ncol, nrow, dim)
+exportMethods(calc, overlay, bbox, aggregate, stack, show, summary, plot, hist, ncol, nrow, ncell, length, dim)
exportPattern("^[^\\.]")
\ No newline at end of file
Modified: pkg/raster/R/Merge.R
===================================================================
--- pkg/raster/R/Merge.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/Merge.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -22,7 +22,7 @@
compare(rasters, bb=FALSE, rowcol=FALSE, orig=TRUE, res=TRUE, tolerance=tolerance)
- bb <- bbUnion(rasters)
+ bb <- unionBbox(rasters)
outraster <- setRaster(rasters[[1]], filename)
# bndbox <- newBbox(bb[1,1], bb[1,2], bb[2,1], bb[2,2])
outraster <- setBbox(outraster, bb, keepres=TRUE, snap=FALSE)
Added: pkg/raster/R/alignBbox.R
===================================================================
--- pkg/raster/R/alignBbox.R (rev 0)
+++ pkg/raster/R/alignBbox.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -0,0 +1,35 @@
+# R function for the raster package
+# Author: Robert J. Hijmans
+# International Rice Research Institute. Philippines
+# contact: r.hijmans at gmail.com
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+alignBbox <- function(bndbox, object) {
+ oldbb <- getBbox(object)
+ bndbox at xmin <- max(bndbox at xmin, oldbb at xmin)
+ bndbox at xmax <- min(bndbox at xmax, oldbb at xmax)
+ bndbox at ymin <- max(bndbox at ymin, oldbb at ymin)
+ bndbox at ymax <- min(bndbox at ymax, oldbb at ymax)
+ col <- colFromX(object, bndbox at xmin)
+ mn <- xFromCol(object, col) - 0.5 * xres(object)
+ mx <- xFromCol(object, col) + 0.5 * xres(object)
+ if (abs(bndbox at xmin - mn) > abs(bndbox at xmin - mx)) { bndbox at xmin <- mx } else { bndbox at xmin <- mn }
+ col <- colFromX(object, bndbox at xmax)
+ mn <- xFromCol(object, col) - 0.5 * xres(object)
+ mx <- xFromCol(object, col) + 0.5 * xres(object)
+ if (abs(bndbox at xmax - mn) > abs(bndbox at xmax - mx)) { bndbox at xmax <- mx } else { bndbox at xmax <- mn }
+ row <- rowFromY(object, bndbox at ymin)
+ mn <- yFromRow(object, row) - 0.5 * yres(object)
+ mx <- yFromRow(object, row) + 0.5 * yres(object)
+ if (abs(bndbox at ymin - mn) > abs(bndbox at ymin - mx)) { bndbox at ymin <- mx } else { bndbox at ymin <- mn }
+ row <- rowFromY(object, bndbox at ymax)
+ mn <- yFromRow(object, row) - 0.5 * yres(object)
+ mx <- yFromRow(object, row) + 0.5 * yres(object)
+ if (abs(bndbox at ymax - mn) > abs(bndbox at ymax - mx)) { bndbox at ymax <- mx } else { bndbox at ymax <- mn }
+ return(bndbox)
+}
+
+
Modified: pkg/raster/R/bboxUnion.R
===================================================================
--- pkg/raster/R/bboxUnion.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/bboxUnion.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -5,9 +5,10 @@
# Version 0.8
# Licence GPL v3
-bbUnion <- function(objects) {
+unionBbox <- function(x, ...) {
+ objects <- c(x, list(...))
if (length(objects) == 1) {
- return(getBbox(objects))
+ return(getBbox(x))
}
bb <- getBbox(objects[[1]])
for (i in 2:length(objects)) {
@@ -20,9 +21,10 @@
return(bb)
}
-bbIntersect <- function(objects) {
+intersectBbox <- function(x, ...) {
+ objects <- c(x, list(...))
if (length(objects) == 1) {
- return(getBbox(objects))
+ return(getBbox(x))
}
bb <- getBbox(objects[[1]])
for (i in 2:length(objects)) {
Modified: pkg/raster/R/crop.R
===================================================================
--- pkg/raster/R/crop.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/crop.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -10,8 +10,8 @@
crop <- function(raster, bndbox, filename="", overwrite=FALSE, filetype='raster', track=-1) {
# we could also allow the raster to expand but for now let's not and first make a separate expand function
- bb <- bbIntersect(c(raster, bndbox))
- bb <- snapBbox(bb, raster)
+ bb <- intersectBbox(c(raster, bndbox))
+ bb <- alignBbox(bb, raster)
outraster <- setRaster(raster, filename)
outraster <- setBbox(outraster, bb, keepres=T)
Modified: pkg/raster/R/distance.R
===================================================================
--- pkg/raster/R/distance.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/distance.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -49,7 +49,10 @@
outRaster <- setValues(outRaster, accDist)
return(outRaster)
}
- if(dataContent(object)=='nodata' & dataSource(object) =='disk'){ #to be tested
+ if( dataSource(object) =='disk'){ #to be tested
+
+ # Fix error: startRow has not been initialized.
+
nrows <- nrow(object)
ncols <- ncol(object)
outRaster <- setRaster(object, filename)
Modified: pkg/raster/R/group.generic.functions.R
===================================================================
--- pkg/raster/R/group.generic.functions.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/group.generic.functions.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -124,110 +124,3 @@
}
)
-
-if (!isGeneric("median")) {
- setGeneric("median", function(x, na.rm=FALSE)
- standardGeneric("median"))
-}
-
-
-setMethod('median', signature(x='Raster'),
- function(x, na.rm=FALSE){
- if (dataContent(x) == 'all') {
- return(median(values(x), na.rm=na.rm))
- } else {
-# needs to be improved for large files. Make frequency table row by row.....
- return(median(values(readAll(x)), na.rm=na.rm))
- }
- }
-)
-
-
-
-
-
-if (!isGeneric("rmedian")) {
- setGeneric("rmedian", function(x, ..., na.rm=FALSE)
- standardGeneric("rmedian"))
-}
-
-setMethod('rmedian', signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, median, na.rm=na.rm)))
- } else {
- stk <- stack(c(x,obs))
- v <- vector()
- for (r in 1:nrow(stk)) {
- v <- c(v, apply(values(readRow(stk, r)), 1, median, na.rm=na.rm))
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-
-setMethod("max", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, max, na.rm=na.rm)))
- } else {
- v <- .getRasterValues(x)
- for (i in 1:length(obs)) {
- v <- apply(cbind(v, .getAllTypeOfValues(x, obs[[i]], i)), 1, max, na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-setMethod("min", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, min, na.rm=na.rm)))
- } else {
- v <- .getRasterValues(x)
- for (i in 1:length(obs)) {
- v <- apply(cbind(v, .getAllTypeOfValues(x, obs[[i]], i)), 1, min, na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-setMethod("sum", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=rowSums(as.matrix(.getRasterValues(x)), na.rm)))
- } else {
- v <- .getRasterValues(x)
- if (!(is.null(dim(v)))) {
- v <- rowSums(as.matrix(.getRasterValues(x)), na.rm=na.rm)
- }
- for (i in 1:length(obs)) {
- vv <- .getAllTypeOfValues(x, obs[[i]], i)
- v <- rowSums(cbind(v, vv), na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-#todo "any", "all"
-
-
-setMethod("range", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- return(max(x, ..., na.rm=na.rm) - min(x, ..., na.rm=na.rm))
- }
-)
-
-
Added: pkg/raster/R/isLatLon.R
===================================================================
--- pkg/raster/R/isLatLon.R (rev 0)
+++ pkg/raster/R/isLatLon.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -0,0 +1,67 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+if (!isGeneric("isLatLon")) {
+ setGeneric("isLatLon", function(object)
+ standardGeneric("isLatLon"))
+}
+
+setMethod('isLatLon', signature(object='Raster'),
+# copied from the SP package (slightly adapted)
+#author:
+# ...
+ function(object){
+ p4str <- projection(object)
+ if (is.na(p4str) || nchar(p4str) == 0) {
+ return(as.logical(NA))
+ }
+ res <- grep("longlat", p4str, fixed = TRUE)
+ if (length(res) == 0) {
+ return(FALSE)
+ } else {
+ return(TRUE)
+ }
+ }
+)
+
+setMethod('isLatLon', signature(object='character'),
+# copied from the SP package (slightly adapted)
+#author:
+# ...
+ function(object){
+ res <- grep("longlat", object, fixed = TRUE)
+ if (length(res) == 0) {
+ return(FALSE)
+ } else {
+ return(TRUE)
+ }
+ }
+)
+
+
+setMethod('isLatLon', signature(object='CRS'),
+# copied from the SP package (slightly adapted)
+#author:
+# ...
+ function(object){
+ if (is.na(object at projargs)) {
+ p4str <- "NA"
+ } else {
+ p4str <- trim(object at projargs)
+ }
+ if (is.na(p4str) || nchar(p4str) == 0) {
+ return(as.logical(NA))
+ }
+ res <- grep("longlat", p4str, fixed = TRUE)
+ if (length(res) == 0) {
+ return(FALSE)
+ } else {
+ return(TRUE)
+ }
+ }
+)
+
Added: pkg/raster/R/layers.R
===================================================================
--- pkg/raster/R/layers.R (rev 0)
+++ pkg/raster/R/layers.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -0,0 +1,52 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : October 2008
+# Version 0,7
+# Licence GPL v3
+
+
+if (!isGeneric("nlayers")) {
+ setGeneric("nlayers", function(object)
+ standardGeneric("nlayers"))
+}
+
+setMethod('nlayers', signature(object='BasicRaster'),
+ function(object){
+ return(0)
+ }
+)
+
+setMethod('nlayers', signature(object='Raster'),
+ function(object){
+ return(1)
+ }
+)
+
+setMethod('nlayers', signature(object='RasterStack'),
+ function(object){
+ return(object at data@nlayers)
+ }
+)
+
+setMethod('nlayers', signature(object='Spatial'),
+ function(object){
+ if ( class(object)=='SpatialPixelsDataFrame' | class(object)=='SpatialGridDataFrame' ) {
+ return( dim(object at data)[2] )
+ } else {
+ return( 0 )
+ }
+ }
+)
+
+
+layerNames <- function(object) {
+ if (class(object) == "RasterLayer") {
+ return(filename(object))
+ } else if (class(object) == "RasterStack") {
+ l <- vector('character')
+ for (i in 1:nlayers(object)) {
+ l <- c(l, filename(asRasterLayer(object, i)))
+ }
+ return(l)
+ }
+}
Added: pkg/raster/R/ncell.R
===================================================================
--- pkg/raster/R/ncell.R (rev 0)
+++ pkg/raster/R/ncell.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -0,0 +1,14 @@
+
+if (!isGeneric("ncell")) {
+ setGeneric("ncell", function(x)
+ standardGeneric("ncell"))
+}
+
+setMethod('ncell', signature(x='ANY'),
+ function(x) {
+ d <- dim(x)
+# return numeric to avoid integer overflow
+ return(as.numeric(d[1]) * d[2])
+ }
+)
+
Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/properties.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -1,72 +1,11 @@
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
# Date : October 2008
-# Version 0,7
+# Version 0.8
# Licence GPL v3
-if (!isGeneric("isLatLon")) {
- setGeneric("isLatLon", function(object)
- standardGeneric("isLatLon"))
-}
-setMethod('isLatLon', signature(object='Raster'),
-# copied from the SP package (slightly adapted)
-#author:
-# ...
- function(object){
- p4str <- projection(object)
- if (is.na(p4str) || nchar(p4str) == 0) {
- return(as.logical(NA))
- }
- res <- grep("longlat", p4str, fixed = TRUE)
- if (length(res) == 0) {
- return(FALSE)
- } else {
- return(TRUE)
- }
- }
-)
-
-setMethod('isLatLon', signature(object='character'),
-# copied from the SP package (slightly adapted)
-#author:
-# ...
- function(object){
- res <- grep("longlat", object, fixed = TRUE)
- if (length(res) == 0) {
- return(FALSE)
- } else {
- return(TRUE)
- }
- }
-)
-
-
-setMethod('isLatLon', signature(object='CRS'),
-# copied from the SP package (slightly adapted)
-#author:
-# ...
- function(object){
- if (is.na(object at projargs)) {
- p4str <- "NA"
- } else {
- p4str <- trim(object at projargs)
- }
- if (is.na(p4str) || nchar(p4str) == 0) {
- return(as.logical(NA))
- }
- res <- grep("longlat", p4str, fixed = TRUE)
- if (length(res) == 0) {
- return(FALSE)
- } else {
- return(TRUE)
- }
- }
-)
-
-
-
filename <- function(object) {
if (class(object) == 'RasterStack') {
return(object at filename)
@@ -74,12 +13,6 @@
return(object at file@name)
}
-ncell <- function(object) {
-# return numeric to avoid integer overflow
- return(return( as.numeric(nrow(object)) * ncol(object )))
-}
-
-
xmin <- function(object) {
object <- getBbox(object)
return(as.numeric(object at xmin))
@@ -113,53 +46,7 @@
}
-if (!isGeneric("nlayers")) {
- setGeneric("nlayers", function(object)
- standardGeneric("nlayers"))
-}
-setMethod('nlayers', signature(object='BasicRaster'),
- function(object){
- return(0)
- }
-)
-
-setMethod('nlayers', signature(object='Raster'),
- function(object){
- return(1)
- }
-)
-
-setMethod('nlayers', signature(object='RasterStack'),
- function(object){
- return(object at data@nlayers)
- }
-)
-
-setMethod('nlayers', signature(object='Spatial'),
- function(object){
- if ( class(object)=='SpatialPixelsDataFrame' | class(object)=='SpatialGridDataFrame' ) {
- return( dim(object at data)[2] )
- } else {
- return( 0 )
- }
- }
-)
-
-
-layerNames <- function(object) {
- if (class(object) == "RasterLayer") {
- return(filename(object))
- } else if (class(object) == "RasterStack") {
- l <- vector('character')
- for (i in 1:nlayers(object)) {
- l <- c(l, filename(asRasterLayer(object, i)))
- }
- return(l)
- }
-}
-
-
band <- function(object) {
if (class(object) == "RasterLayer") {
return(object at file@band)
Modified: pkg/raster/R/rasterToPoints.R
===================================================================
--- pkg/raster/R/rasterToPoints.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/rasterToPoints.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -6,36 +6,38 @@
-rasterToPoints <- function(raster, rm.na=TRUE, fun=NULL, asSpatialPoints=FALSE) {
+rasterToPoints <- function(raster, fun=NULL, asSpatialPoints=FALSE) {
+ if (dataSource(raster) == 'ram' & dataContent(raster) != 'all') {
+ if (asSpatialPoints) {
+ coords <- xyFromCell(raster, 1:ncell(raster))
+ row.names(coords) <- 1:nrow(coords)
+ return(SpatialPoints(coords=coords, proj4string=projection(raster, asText=F)))
+ } else {
+ return(xyFromCell(raster, 1:ncell(raster)))
+ }
+ }
+
if (dataContent(raster) == 'all') {
v <- values(raster)
raster <- clearValues(raster)
xyv <- cbind(xyFromCell(raster, 1:ncell(raster)), v)
- if (rm.na) {
- xyv <- subset(xyv, !(is.na(xyv[,3])))
- }
+ xyv <- subset(xyv, !(is.na(xyv[,3])))
if (!is.null(fun)) {
xyv <- subset(xyv, fun(xyv[,3]))
}
} else {
- if (dataSource == 'ram') {
- return(xyFromCell(raster, 1:ncell(raster)))
- } else {
- xyv <- matrix(NA, ncol=3, nrow=0)
- colnames(xyv) <- c('x', 'y', 'v')
- x <- xFromCol(raster, 1:ncol(raster))
- for (r in 1:nrow(raster)) {
- y <- yFromRow(raster, r)
- raster <- readRow(raster, r)
- xyvr <- cbind(x, y, values(raster))
- if (rm.na) {
- xyvr <- subset(xyvr, !(is.na(xyvr[,3])))
- }
- if (!is.null(fun)) {
- xyvr <- subset(xyvr, fun(xyvr[,3]))
- }
- xyv <- rbind(xyv, xyvr)
+ xyv <- matrix(NA, ncol=3, nrow=0)
+ colnames(xyv) <- c('x', 'y', 'v')
+ x <- xFromCol(raster, 1:ncol(raster))
+ for (r in 1:nrow(raster)) {
+ y <- yFromRow(raster, r)
+ raster <- readRow(raster, r)
+ xyvr <- cbind(x, y, values(raster))
+ xyvr <- subset(xyvr, !(is.na(xyvr[,3])))
+ if (!is.null(fun)) {
+ xyvr <- subset(xyvr, fun(xyvr[,3]))
}
+ xyv <- rbind(xyv, xyvr)
}
}
if (asSpatialPoints) {
Modified: pkg/raster/R/setBbox.R
===================================================================
--- pkg/raster/R/setBbox.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/setBbox.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -7,41 +7,13 @@
# Licence GPL v3
-
-snapBbox <- function(bb, object) {
- oldbb <- getBbox(object)
- bb at xmin <- max(bb at xmin, oldbb at xmin)
- bb at xmax <- min(bb at xmax, oldbb at xmax)
- bb at ymin <- max(bb at ymin, oldbb at ymin)
- bb at ymax <- min(bb at ymax, oldbb at ymax)
- col <- colFromX(object, bb at xmin)
- mn <- xFromCol(object, col) - 0.5 * xres(object)
- mx <- xFromCol(object, col) + 0.5 * xres(object)
- if (abs(bb at xmin - mn) > abs(bb at xmin - mx)) { bb at xmin <- mx } else { bb at xmin <- mn }
- col <- colFromX(object, bb at xmax)
- mn <- xFromCol(object, col) - 0.5 * xres(object)
- mx <- xFromCol(object, col) + 0.5 * xres(object)
- if (abs(bb at xmax - mn) > abs(bb at xmax - mx)) { bb at xmax <- mx } else { bb at xmax <- mn }
- row <- rowFromY(object, bb at ymin)
- mn <- yFromRow(object, row) - 0.5 * yres(object)
- mx <- yFromRow(object, row) + 0.5 * yres(object)
- if (abs(bb at ymin - mn) > abs(bb at ymin - mx)) { bb at ymin <- mx } else { bb at ymin <- mn }
- row <- rowFromY(object, bb at ymax)
- mn <- yFromRow(object, row) - 0.5 * yres(object)
- mx <- yFromRow(object, row) + 0.5 * yres(object)
- if (abs(bb at ymax - mn) > abs(bb at ymax - mx)) { bb at ymax <- mx } else { bb at ymax <- mn }
- return(bb)
-}
-
-
-
setBbox <- function(object, bndbox, keepres=FALSE, snap=FALSE) {
oldbb <- getBbox(object)
bb <- getBbox(bndbox)
newobj <- clearValues(object)
if (snap) {
- bb <- snapBbox(bb, newobj)
+ bb <- alignBbox(bb, newobj)
}
newobj at bbox <- bb
Modified: pkg/raster/R/standard.generic.functions.R
===================================================================
--- pkg/raster/R/standard.generic.functions.R 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/R/standard.generic.functions.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -18,57 +18,6 @@
)
-
-setMethod('summary', signature(object='RasterStack'),
- function(object, ...) {
- if (dataContent(object) == 'all') {
- for (n in 1:nlayers(object)) {
- cat("layer ", n, "\n")
- cat("NAs : ", sum(is.na(values(object)[,n])), "\n")
- summary(values(object)[,n])
- }
- } else {
- cat("values not in memory\n")
- }
- }
-)
-
-
-
-setClass('RasterLayerSummary',
- representation (
- ncell = 'numeric',
- dataContent = 'character',
- NAs = 'numeric',
- values = 'matrix'
- )
+setMethod('length', signature(x='Raster'),
+ function(x) { return(length(x at data@values)) }
)
-
-setMethod('show', signature(object='RasterLayerSummary'),
- function(object) {
- cat ("Cells: " , object at ncell, "\n")
- if ( object at dataContent == "all") {
- cat("NAs : ", object at NAs, "\n")
- cat("\nValues")
- tab <- as.table(object at values)
- colnames(tab) <- ""
- print(tab)
- } else {
- cat("values not in memory\n")
- }
- }
-)
-
-setMethod('summary', signature(object='RasterLayer'),
- function(object, ...) {
- sumobj <- new("RasterLayerSummary")
- sumobj at ncell <- ncell(object)
- sumobj at dataContent <- dataContent(object)
- if ( sumobj at dataContent == "all") {
- sumobj at NAs <- sum(is.na(values(object)))
- sumobj at values <- as.matrix( summary(values(object)) )
- }
- return(sumobj)
- }
-)
-
Added: pkg/raster/R/summary.R
===================================================================
--- pkg/raster/R/summary.R (rev 0)
+++ pkg/raster/R/summary.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -0,0 +1,61 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,8
+# Licence GPL v3
+
+
+
+setMethod('summary', signature(object='RasterStack'),
+ function(object, ...) {
+ if (dataContent(object) == 'all') {
+ for (n in 1:nlayers(object)) {
+ cat("layer ", n, "\n")
+ cat("NAs : ", sum(is.na(values(object)[,n])), "\n")
+ summary(values(object)[,n])
+ }
+ } else {
+ cat("values not in memory\n")
+ }
+ }
+)
+
+
+
+setClass('RasterLayerSummary',
+ representation (
+ ncell = 'numeric',
+ dataContent = 'character',
+ NAs = 'numeric',
+ values = 'matrix'
+ )
+)
+
+setMethod('show', signature(object='RasterLayerSummary'),
+ function(object) {
+ cat ("Cells: " , object at ncell, "\n")
+ if ( object at dataContent == "all") {
+ cat("NAs : ", object at NAs, "\n")
+ cat("\nValues")
+ tab <- as.table(object at values)
+ colnames(tab) <- ""
+ print(tab)
+ } else {
+ cat("values not in memory\n")
+ }
+ }
+)
+
+setMethod('summary', signature(object='RasterLayer'),
+ function(object, ...) {
+ sumobj <- new("RasterLayerSummary")
+ sumobj at ncell <- ncell(object)
+ sumobj at dataContent <- dataContent(object)
+ if ( sumobj at dataContent == "all") {
+ sumobj at NAs <- sum(is.na(values(object)))
+ sumobj at values <- as.matrix( summary(values(object)) )
+ }
+ return(sumobj)
+ }
+)
+
Added: pkg/raster/R/summary.methods.R
===================================================================
--- pkg/raster/R/summary.methods.R (rev 0)
+++ pkg/raster/R/summary.methods.R 2009-02-22 05:54:40 UTC (rev 289)
@@ -0,0 +1,133 @@
+# Authors: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+
+setMethod("max", signature(x='Raster'),
+ function(x, ..., na.rm=FALSE){
+ obs <- list(...)
+ if (length(obs) == 0) {
+ # this is for a RasterStack
+ return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, max, na.rm=na.rm)))
+ } else {
+ v <- .getRasterValues(x)
+ for (i in 1:length(obs)) {
+ v <- apply(cbind(v, .getAllTypeOfValues(x, obs[[i]], i)), 1, max, na.rm=na.rm)
+ }
+ return(setRaster(x, values=v))
+ }
+ }
+)
+
+
+setMethod("min", signature(x='Raster'),
+ function(x, ..., na.rm=FALSE){
+ obs <- list(...)
+ if (length(obs) == 0) {
+ return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, min, na.rm=na.rm)))
+ } else {
+ v <- .getRasterValues(x)
+ for (i in 1:length(obs)) {
+ v <- apply(cbind(v, .getAllTypeOfValues(x, obs[[i]], i)), 1, min, na.rm=na.rm)
+ }
+ return(setRaster(x, values=v))
+ }
+ }
+)
+
+
+setMethod("sum", signature(x='Raster'),
+ function(x, ..., na.rm=FALSE){
+ obs <- list(...)
+ if (length(obs) == 0) {
+ return(setRaster(x, values=rowSums(as.matrix(.getRasterValues(x)), na.rm)))
+ } else {
+ v <- .getRasterValues(x)
+ if (!(is.null(dim(v)))) {
+ v <- rowSums(as.matrix(.getRasterValues(x)), na.rm=na.rm)
+ }
+ for (i in 1:length(obs)) {
+ vv <- .getAllTypeOfValues(x, obs[[i]], i)
+ v <- rowSums(cbind(v, vv), na.rm=na.rm)
+ }
+ return(setRaster(x, values=v))
+ }
+ }
+)
+
+
+#todo "any", "all"
+
+
+setMethod("mean", signature(x='Raster'),
+ function(x, ..., na.rm=FALSE){
+ obs <- list(...)
+ if (length(obs) == 0) {
+ return(setRaster(x, values=rowMeans(as.matrix(.getRasterValues(x)), na.rm)))
+ } else {
+ v <- .getRasterValues(x)
+ if (!(is.null(dim(v)))) {
+ v <- rowMeans(as.matrix(.getRasterValues(x)), na.rm=na.rm)
+ }
+ for (i in 1:length(obs)) {
+ vv <- .getAllTypeOfValues(x, obs[[i]], i)
+ v <- rowMeans(cbind(v, vv), na.rm=na.rm)
+ }
+ return(setRaster(x, values=v))
+ }
+ }
+)
+
+
+
+
+setMethod("range", signature(x='Raster'),
+ function(x, ..., na.rm=FALSE){
+ return(max(x, ..., na.rm=na.rm) - min(x, ..., na.rm=na.rm))
+ }
+)
+
+
+
+#if (!isGeneric("median")) {
+# setGeneric("median", function(x, na.rm=FALSE)
+# standardGeneric("median"))
+#}
+
+
+#setMethod('median', signature(x='Raster'),
+# function(x, na.rm=FALSE){
+# if (dataContent(x) == 'all') {
+# return(median(values(x), na.rm=na.rm))
+# } else {
+# needs to be improved for large files. Make frequency table row by row.....
+# return(median(values(readAll(x)), na.rm=na.rm))
+# }
+# }
+#)
+
+
+#if (!isGeneric("rmedian")) {
+# setGeneric("rmedian", function(x, ..., na.rm=FALSE)
+# standardGeneric("rmedian"))
+#}
+
+#setMethod('rmedian', signature(x='Raster'),
+# function(x, ..., na.rm=FALSE){
+# obs <- list(...)
+# if (length(obs) == 0) {
+# return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, median, na.rm=na.rm)))
+# } else {
+# stk <- stack(c(x,obs))
+# v <- vector()
+# for (r in 1:nrow(stk)) {
+# v <- c(v, apply(values(readRow(stk, r)), 1, median, na.rm=na.rm))
+# }
+# return(setRaster(x, values=v))
+# }
+# }
+#)
+
Modified: pkg/raster/man/Summary-methods.Rd
===================================================================
--- pkg/raster/man/Summary-methods.Rd 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/man/Summary-methods.Rd 2009-02-22 05:54:40 UTC (rev 289)
@@ -4,10 +4,11 @@
\alias{max,Raster-method}
\alias{min,Raster-method}
\alias{range,Raster-method}
+\alias{mean,Raster-method}
\title{ Summary methods for Raster* objects }
\description{
- The following methods have been implemented: sum, max, min, range
+ The following methods have been implemented: sum, max, min, range and mean
These methods compare layers and the result of these methods is always a single RasterLayer.
For the extreme values within in a layer use maxValue() and minValue()
Modified: pkg/raster/man/bbox.Rd
===================================================================
--- pkg/raster/man/bbox.Rd 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/man/bbox.Rd 2009-02-22 05:54:40 UTC (rev 289)
@@ -10,6 +10,9 @@
\alias{newBbox}
\alias{setBbox}
\alias{changeBbox}
+\alias{unionBbox}
+\alias{intersectBbox}
+\alias{alignBbox}
\alias{xmin<-}
\alias{xmax<-}
@@ -22,6 +25,9 @@
newBbox creates a new bounding box (as in the "Spatial" object from the SP package)
setBbox sets the bounding box of a Raster* object
changeBbox changes the bounding box of a Raster* object
+alignBbox aligns a bounding box with the cells of a Raster* object
+unionBbox returns the union of multiple bounding boxes
+intersectBbox returns the instersection of multiple bounding boxes
}
\usage{
@@ -29,6 +35,9 @@
getBbox(object)
setBbox(object, bndbox, keepres=FALSE, snap=FALSE)
changeBbox(object, xmn=xmin(object), xmx=xmax(object), ymn=ymin(object), ymx = ymax(object), keepres=FALSE)
+alignBbox(bndbox, object)
+unionBbox(x, ...)
+intersectBbox(x, ...)
}
\arguments{
@@ -40,6 +49,8 @@
\item{bndbox}{An object of class BoundingBox (which you can create with newBbox() )}
\item{keepres}{logical. If \code{TRUE}, the resolution of the cells will stay the same after adjusting the bounding box (by adjusting the number of rows and columns). if \code{FALSE}, the number of rows and columns will stay the same, and the resolution will be adjusted}
\item{snap}{Adjust the bounding box so that the new raster is aligned with the old raster }
+ \item{x}{A BoundingBox or Raster* object }
+ \item{...}{ additional BoundingBox or Raster* objects }
}
\value{
Modified: pkg/raster/man/properties.Rd
===================================================================
--- pkg/raster/man/properties.Rd 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/man/properties.Rd 2009-02-22 05:54:40 UTC (rev 289)
@@ -6,6 +6,8 @@
\alias{nrow,BasicRaster-method}
\alias{ncol,BasicRaster-method}
\alias{ncell}
+\alias{ncell,ANY-method}
+\alias{length,Raster-method}
\alias{xres}
\alias{yres}
\alias{resolution}
@@ -32,10 +34,9 @@
\alias{dataSize}
-\title{RasterLayer properties}
+\title{Raster properties}
\description{
- get the column, row, or cell number of a Raster (or RasterStack) for a x and/or y coordinate or get the coordinates of the center of a raster-cell from a column, or cell number(s)
-
+ Get properties of a RasterLayer or RasterStack
}
\usage{
Modified: pkg/raster/man/rasterToPoints.Rd
===================================================================
--- pkg/raster/man/rasterToPoints.Rd 2009-02-22 03:02:58 UTC (rev 288)
+++ pkg/raster/man/rasterToPoints.Rd 2009-02-22 05:54:40 UTC (rev 289)
@@ -4,16 +4,15 @@
\title{ Raster to points conversion}
\description{
-Raster to point conversion.
+Raster to point conversion. Cells with NA are not converted. A function can be used to select a subset of the raster cells (by their values).
}
\usage{
-rasterToPoints(raster, rm.na=TRUE, fun=NULL, asSpatialPoints=FALSE)
+rasterToPoints(raster, fun=NULL, asSpatialPoints=FALSE)
}
\arguments{
\item{raster}{ a RasterLayer object }
- \item{rm.na}{ if \code{TRUE}, cells with NA values will not be converted }
- \item{fun}{ function to select a subset of raster values}
+ \item{fun}{ function to select a subset of raster values }
\item{asSpatialPoints}{if \code{TRUE}, the function returns a SpatialPointsDataFrame object }
}
More information about the Raster-commits
mailing list