[Raster-commits] r111 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jan 10 10:43:47 CET 2009
Author: rhijmans
Date: 2009-01-10 10:43:46 +0100 (Sat, 10 Jan 2009)
New Revision: 111
Added:
pkg/raster/R/compare.R
Modified:
pkg/raster/R/Merge.R
pkg/raster/R/get.R
pkg/raster/R/properties.R
pkg/raster/R/stack.read.R
pkg/raster/R/standard.generic.functions.R
pkg/raster/man/raster.change.Rd
pkg/raster/man/utils.Rd
Log:
Modified: pkg/raster/R/Merge.R
===================================================================
--- pkg/raster/R/Merge.R 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/R/Merge.R 2009-01-10 09:43:46 UTC (rev 111)
@@ -3,18 +3,14 @@
# International Rice Research Institute
#contact: r.hijmans at gmail.com
# Date : October 2008
-# Version 0,7
+# Version 0.7
# Licence GPL v3
-Merge <- function(rasters, slack=0.01, filename="", overwrite=FALSE) {
- compare(rasters, rowcol=FALSE, slack=slack)
+Merge <- function(rasters, tolerance=0.0001, filename="", overwrite=FALSE) {
+ compare(rasters, bb=FALSE, rowcol=FALSE, orig=TRUE, tolerance=tolerance)
-# for (i in 1:length(rasters)) {
-# if (!(data.source(rasters[[i]]) == 'disk' | dataContent(rasters[[i]]) == 'all' | dataContent(rasters[[i]]) == 'sparse')) {
-# stop('rasters should be stored on disk or values should be in memory')
-# }
-# }
+# f
bb <- boundingbox(rasters[[1]])
for (i in 2:length(rasters)) {
@@ -39,7 +35,7 @@
rd <- as.vector(matrix(NA, nrow=1, ncol=ncol(outraster)))
for (i in length(rasters):1) { #reverse order so that the first raster covers the second etc.
if (r >= rowcol[i,1] & r <= rowcol[i,2]) {
- if (rasters[[i]]@data at source == 'disk') {
+ if (dataSource(rasters[[i]]) == 'disk') {
rasters[[i]] <- readRow(rasters[[i]], r + 1 - rowcol[i,1])
d <- values(rasters[[i]])
} else if (dataContent(rasters[[i]]) == 'all') {
Added: pkg/raster/R/compare.R
===================================================================
--- pkg/raster/R/compare.R (rev 0)
+++ pkg/raster/R/compare.R 2009-01-10 09:43:46 UTC (rev 111)
@@ -0,0 +1,57 @@
+# R code for changing rasters (spatial data)
+# Authors: Robert J. Hijmans
+# International Rice Research Institute
+#contact: r.hijmans at gmail.com
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+compare <- function(objects, bb=TRUE, rowcol=TRUE, prj=TRUE, res=FALSE, orig=FALSE, tolerance=0.05, stopiffalse=TRUE) {
+ result <- TRUE
+ if (!isTRUE(length(objects) > 1)) {
+ result <- F
+ stop('The first argument should consist of at least 2 Raster* objects')
+ }
+ minres <- min(resolution(objects[[1]]))
+ for (i in 2:length(objects)) {
+ if (bb) {
+ if (!(isTRUE(all.equal(boundingbox(objects[[1]]), boundingbox(objects[[i]]), tolerance=tolerance, scale=minres )))) {
+ result <- F
+ if (stopiffalse) { stop('Different bounding boxes') }
+ }
+ }
+ if (rowcol) {
+ if ( !(identical(ncol(objects[[1]]), ncol(objects[[i]]))) ) {
+ result <- F
+ if (stopiffalse) { stop('ncols different') }
+ }
+ if ( !(identical(nrow(objects[[1]]), nrow(objects[[i]]))) ) {
+ result <- F
+ if (stopiffalse) { stop('nrows different') }
+ }
+ }
+ if (prj) {
+ if ( !(identical(projection(objects[[1]]), projection(objects[[i]])))) {
+ result <- F
+ if (stopiffalse) {stop('different projections')}
+ }
+ }
+# Can also check res through bb & rowcol
+ if (res) {
+ if (!(isTRUE(all.equal(resolution(objects[[1]]), resolution(objects[[i]]), tolerance=tolerance, scale=minres)))) {
+ result <- F
+ if (stopiffalse) { stop('different resolution') }
+ }
+ }
+# Can also check orig through bb & rowcol, but orig is useful for e.g. Merge(raster, raster)
+ if (orig) {
+ if (!(isTRUE(all.equal(origin(objects[[1]]), origin(objects[[i]]), tolerance=tolerance, scale=minres)))) {
+ result <- F
+ if (stopiffalse) { stop('different origin') }
+ }
+ }
+ }
+ return(result)
+}
Modified: pkg/raster/R/get.R
===================================================================
--- pkg/raster/R/get.R 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/R/get.R 2009-01-10 09:43:46 UTC (rev 111)
@@ -64,7 +64,7 @@
}
cell <- vector(mode = "integer", length = length(x))
cell[] <- NA
- for (i in 1:length(x)) {
+ for (i in seq(length(x))) {
colnr <- colFromX(object, x[i]) - 1
rownr <- rowFromY(object, y[i]) - 1
if ((!is.na(colnr)) & (!is.na(rownr))) {
Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/R/properties.R 2009-01-10 09:43:46 UTC (rev 111)
@@ -130,6 +130,8 @@
maxValue <- function(object, layer=1) {
+ layer <- round(layer)
+ layer <- max(1, min(nlayers(object), layer))
if (layer < 1) { return(NA)
} else { return(object at data@max[layer]) }
}
@@ -147,58 +149,3 @@
return(object at data@source)
}
-
-compare <- function(rasters, origin=TRUE, resolution=TRUE, rowcol=TRUE, projection=TRUE, slack=0.01, stopiffalse=TRUE) {
- res <- TRUE
- if (length(rasters) < 2) {
- res <- F
- stop('length(rasters) < 2')
- }
- res1 <- resolution(rasters[[1]])
- origin1 <- origin(rasters[[1]])
- for (i in 2:length(rasters)) {
- if (rowcol) {
- if (ncol(rasters[[1]]) != ncol(rasters[[i]])) {
- res <- F
- if(stopiffalse) { stop('ncols different') }
- }
- if (nrow(rasters[[1]]) != nrow(rasters[[i]])) {
- res <- F
- if(stopiffalse) { stop('nrows different') }
- }
- }
- if (projection) {
- if (projection(rasters[[1]]) != projection(rasters[[2]]) ) {
- res <- F
- if(stopiffalse) {stop('different projections')}
- }
- }
- resi <- resolution(rasters[[i]])
- xr <- min(res1[1], resi[1])
- yr <- min(res1[2], resi[2])
- if (resolution) {
- if (abs(resi[1] - res1[1]) > slack * xr) {
- res <- F
- if(stopiffalse) { stop('different x resolution') }
- }
- if (abs(resi[2] - res1[2]) > slack * yr) {
- res <- F
- if(stopiffalse) { stop('different y resolution') }
- }
- }
- if (origin) {
- origini <- origin(rasters[[1]])
- if ((abs(origini[1] - origin1[1])) > slack * xr) {
- res <- F
- if(stopiffalse) { stop('different x origins') }
- }
- if ((abs(origini[2] - origin1[2])) > slack * yr) {
- res <- F
- if(stopiffalse) { stop('different y origins')}
- }
- }
- }
- return(res)
-}
-
-
Modified: pkg/raster/R/stack.read.R
===================================================================
--- pkg/raster/R/stack.read.R 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/R/stack.read.R 2009-01-10 09:43:46 UTC (rev 111)
@@ -6,17 +6,17 @@
.stackRead <- function(rstack, rownumber, startcol=1, ncolumns=(ncol(rstack)-startcol+1)) {
- for (i in 1:length(rstack at rasters)) {
+ for (i in seq(nlayers(rstack))) {
raster <- readPartOfRow(rstack at rasters[[i]], rownumber, startcol, ncolumns)
if ( i == 1 ) {
rstack at data@values <- as.matrix(values(raster))
+ rstack at data@content <- dataContent(raster)
+ rstack at data@indices <- dataIndices(raster)
}
else {
rstack at data@values <- cbind(rstack at data@values, values(raster))
}
}
- rstack at data@content <- dataContent(raster)
- rstack at data@indices <- dataIndices(raster)
return(rstack)
}
@@ -28,7 +28,7 @@
.stackReadCells <- function(rasterstack, cells) {
- for (i in 1:nlayers(rasterstack)) {
+ for (i in seq(nlayers(rasterstack))) {
v <- .rasterReadCells (rasterstack at rasters[[i]], cells)
if (i == 1) {
result <- v
@@ -38,7 +38,7 @@
}
}
if (!(is.null(dim(result)))) {
- for (i in 1:nlayers(rasterstack)) {
+ for (i in seq(nlayers(rasterstack))) {
label <- rasterstack at rasters[[i]]@file at shortname
if (nchar(label) == "") {
label <- paste("raster_", i, sep="")
Modified: pkg/raster/R/standard.generic.functions.R
===================================================================
--- pkg/raster/R/standard.generic.functions.R 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/R/standard.generic.functions.R 2009-01-10 09:43:46 UTC (rev 111)
@@ -9,19 +9,14 @@
setMethod('==', signature(e1='AbstractRaster', e2='AbstractRaster'),
function(e1,e2){
- cond <- compare(c(e1, e2), origin=TRUE, resolution=TRUE, rowcol=TRUE, projection=TRUE, slack=0.01, stopiffalse=FALSE)
-# c1 <- identical(ncol(e1), ncol(e2))
-# c2 <- identical(nrow(e1), nrow(e2))
-# c3 <- identical(boundingbox(e1), boundingbox(e2))
-# c4 <- identical(projection(e1),projection(e2))
-# cond <- c1 & c2 & c3 & c4
+ cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE)
return(cond)
}
)
setMethod('!=', signature(e1='AbstractRaster', e2='AbstractRaster'),
function(e1,e2){
- cond <- compare(c(e1, e2), origin=TRUE, resolution=TRUE, rowcol=TRUE, projection=TRUE, slack=0.01, stopiffalse=FALSE)
+ cond <- compare(c(e1, e2), bb=TRUE, rowcol=TRUE, prj=TRUE, tolerance=0.0001, stopiffalse=FALSE)
return(!cond)
}
)
@@ -326,7 +321,7 @@
setMethod("plot", signature(x='RasterLayer', y='RasterLayer'),
function(x, y, ...) {
- comp <- compare(c(x, y), origin=FALSE, resolution=FALSE, rowcol=TRUE, projection=FALSE, slack=0, stopiffalse=TRUE)
+ comp <- compare(c(x, y), bb=TRUE, rowcol=TRUE, prj=FALSE, tolerance=0.0001, stopiffalse=TRUE)
maxdim <- .getmaxdim(...)
nc <- ncells(x)
x <- readSkip(x, maxdim=maxdim)
Modified: pkg/raster/man/raster.change.Rd
===================================================================
--- pkg/raster/man/raster.change.Rd 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/man/raster.change.Rd 2009-01-10 09:43:46 UTC (rev 111)
@@ -14,7 +14,7 @@
disaggregate(raster, fact=2, filename="", overwrite=FALSE)
crop(raster, bndbox, filename="", overwrite=FALSE)
expand(raster, bndbox, filename="", overwrite=FALSE)
-Merge(rasters, slack=0.01, filename="", overwrite=FALSE)
+Merge(rasters, tolerance=0.0001, filename="", overwrite=FALSE)
}
\arguments{
@@ -28,7 +28,7 @@
\item{rm.NA}{ if \code{rm.NA == TRUE}, remove NA cells from calculations }
\item{ForceIntOutput}{ logical. If \code{TRUE} the values will be rounded and stored as integer }
\item{overwrite}{ if TRUE, "filename" will be overwritten if it exists }
- \item{slack}{ }
+ \item{tolerance}{ }
}
\details{
Modified: pkg/raster/man/utils.Rd
===================================================================
--- pkg/raster/man/utils.Rd 2009-01-09 16:29:15 UTC (rev 110)
+++ pkg/raster/man/utils.Rd 2009-01-10 09:43:46 UTC (rev 111)
@@ -12,19 +12,19 @@
}
\usage{
-compare(rasters, origin=TRUE, resolution=TRUE, rowcol=TRUE, projection=TRUE, slack=0.01, stopiffalse=TRUE)
+compare(objects, bb=TRUE, rowcol=TRUE, prj=TRUE, res=FALSE, orig=FALSE, tolerance=0.05, stopiffalse=TRUE)
roundCoords(object, digits=0)
newCRS(projstring)
-
}
\arguments{
- \item{rasters} { vector of RasterLayer objects}
- \item{origin} { logical. If \code{TRUE}, origins of rasters are compared}
- \item{resolution}{logical. If \code{TRUE}, resolution of rasters are compared }
- \item{rowcol}{logical. If \code{TRUE}, number of rows and columns of rasters are compared}
- \item{projection}{ logical. If \code{TRUE} projections are compared.}
- \item{slack} { fraction difference allowed in comparing origin and resolution }
+ \item{objects} { vector or list of Raster* objects }
+ \item{bb} { logical. If \code{TRUE}, bounding boxes are compared}
+ \item{rowcol}{logical. If \code{TRUE}, number of rows and columns of the objects are compared}
+ \item{prj}{ logical. If \code{TRUE} projections are compared.}
+ \item{res} { logical. If \code{TRUE}, resolutions are compared}
+ \item{orig} { logical. If \code{TRUE}, origins are compared}
+ \item{tolerance} { difference permissable (relative to the cell resolution) for objects to be 'equal', for non integer numbers in origin and resolution. See ?all.equal }
\item{stopiffalse}{logical. If \code{TRUE}, an error will be reported if rasters are not the same}
\item{object} { a Raster* object }
\item{digits} { integer indicating the precision to be used}
@@ -40,6 +40,7 @@
r3 <- setRowCol(r1, 10)
# compare(c(r1, r3))
compare(c(r1, r3), stopiffalse=FALSE)
- compare(c(r1, r3), resolution=FALSE, rowcol=FALSE)
+ compare(c(r1, r3), rowcol=FALSE)
}
\keyword{ spatial }
+
More information about the Raster-commits
mailing list