[Raster-commits] r113 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jan 10 17:06:50 CET 2009
Author: rhijmans
Date: 2009-01-10 17:06:50 +0100 (Sat, 10 Jan 2009)
New Revision: 113
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/Merge.R
pkg/raster/R/aggregate.R
pkg/raster/R/all.classes.R
pkg/raster/R/brick.create.R
pkg/raster/R/compare.R
pkg/raster/R/conversion.R
pkg/raster/R/crop.R
pkg/raster/R/expand.R
pkg/raster/R/map.R
pkg/raster/R/properties.R
pkg/raster/R/raster.create.R
pkg/raster/R/raster.read.R
pkg/raster/R/set.R
pkg/raster/R/standard.generic.functions.R
pkg/raster/man/bbox.Rd
pkg/raster/man/properties.Rd
pkg/raster/man/raster.change.Rd
Log:
re-introduced boundingbox class
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/DESCRIPTION 2009-01-10 16:06:50 UTC (rev 113)
@@ -2,7 +2,7 @@
Type: Package
Title: Raster data handling for geographic data analysis and modeling
Version: 0.8.4
-Date: 9-Jan-2009
+Date: 10-Jan-2009
Depends: methods, sp, rgdal (>= 0.5-33)
Author: Robert J. Hijmans & Jacob van Etten
Maintainer: Robert J. Hijmans <r.hijmans at gmail.com>
Modified: pkg/raster/R/Merge.R
===================================================================
--- pkg/raster/R/Merge.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/Merge.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -7,20 +7,45 @@
# Licence GPL v3
-Merge <- function(rasters, tolerance=0.0001, filename="", overwrite=FALSE) {
- compare(rasters, bb=FALSE, rowcol=FALSE, orig=TRUE, tolerance=tolerance)
-
-# f
+.outerBox <- function(objects) {
+ if (length(objects) == 1) {
+ return(getBbox(objects))
+ }
+ bb <- getBbox(objects[[1]])
+ for (i in 2:length(objects)) {
+ bb2 <- getBbox(objects[[i]])
+ bb at xmin <- min(bb at xmin, bb2 at xmin)
+ bb at xmax <- max(bb at xmax, bb2 at xmax)
+ bb at ymin <- min(bb at ymin, bb2 at ymin)
+ bb at ymax <- max(bb at ymax, bb2 at ymax)
+ }
+ return(bb)
+}
- bb <- boundingbox(rasters[[1]])
- for (i in 2:length(rasters)) {
- bb2 <- boundingbox(rasters[[i]])
- bb[,1] <- pmin(bb[,1], bb2[,1])
- bb[,2] <- pmax(bb[,2], bb2[,2])
+.innerBox <- function(objects) {
+ if (length(objects) == 1) {
+ return(getBbox(objects))
}
+ bb <- getBbox(objects[[1]])
+ for (i in 2:length(objects)) {
+ bb2 <- getBbox(objects[[i]])
+ bb at xmin <- max(bb at xmin, bb2 at xmin)
+ bb at xmax <- min(bb at xmax, bb2 at xmax)
+ bb at ymin <- max(bb at ymin, bb2 at ymin)
+ bb at ymax <- min(bb at ymax, bb2 at ymax)
+ }
+ validObject(bb)
+ return(bb)
+}
+
+
+
+Merge <- function(rasters, tolerance=0.05, filename="", overwrite=FALSE) {
+ compare(rasters, bb=FALSE, rowcol=FALSE, orig=TRUE, res=TRUE, tolerance=tolerance)
+ bb <- .outerBox(rasters)
outraster <- setRaster(rasters[[1]], filename)
- bndbox <- newBbox(bb[1,1], bb[1,2], bb[2,1], bb[2,2])
- outraster <- setBbox(outraster, bndbox, keepres=TRUE)
+# bndbox <- newBbox(bb[1,1], bb[1,2], bb[2,1], bb[2,2])
+ outraster <- setBbox(outraster, bb, keepres=TRUE)
rowcol <- matrix(0, ncol=3, nrow=length(rasters))
for (i in 1:length(rasters)) {
@@ -30,6 +55,7 @@
rowcol[i,2] <- rowFromY(outraster, xy2[2]) #end row
rowcol[i,3] <- colFromX(outraster, xy1[1]) #start col
}
+
v <- vector(length=0)
for (r in 1:nrow(outraster)) {
rd <- as.vector(matrix(NA, nrow=1, ncol=ncol(outraster)))
Modified: pkg/raster/R/aggregate.R
===================================================================
--- pkg/raster/R/aggregate.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/aggregate.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -31,7 +31,7 @@
outraster <- setRaster(raster, filename)
bndbox <- newBbox(xmin(raster), xmx, ymn, ymax(raster))
- outraster <- setBbox(outraster, bndbox)
+ outraster <- setBbox(outraster, bndbox, keepres=F)
outraster <- setRowCol(outraster, nrows=rsteps, ncols=csteps)
if (ForceIntOutput) {
Modified: pkg/raster/R/all.classes.R
===================================================================
--- pkg/raster/R/all.classes.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/all.classes.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -7,38 +7,39 @@
# Licence GPL v3
-# the below may be necessary as the function is not imported from SP (it is internal)
-# It is to check the bounds of lat/lon values, SP gives an error, I prefer a warning
-.ll_sanity <- function(bb) {
- outside <- FALSE
- if (bb[1,1] < -180) {outside <- TRUE }
- if (bb[1,2] > 180) {outside <- TRUE }
- if (bb[2,1] < -90) {outside <- TRUE }
- if (bb[2,2] > 90) {outside <- TRUE }
- if (outside) { warning('latitude/longitude values are outside their normal range') }
- return(TRUE)
-}
+setClass('BoundingBox',
+ representation (
+ xmin = 'numeric',
+ xmax = 'numeric',
+ ymin = 'numeric',
+ ymax = 'numeric'
+ ),
+ prototype (
+ xmin = 0,
+ xmax = 1,
+ ymin = 0,
+ ymax = 1
+ ),
+ validity = function(object)
+ {
+ c1 <- (object at xmin <= object at xmax)
+ c2 <- (object at ymin <= object at ymax)
+ return(c1 & c2)
+ }
+)
-#setMethod ('show' , 'Spatial',
-# function(object) {
-# cat('class :', class(object), '\n')
-# cat('projection:', projection(object), '\n')
-# boundingbox(object)
-# }
-#)
-
-
setClass ('AbstractRaster',
-# importing "Spatial" (bounding box + Proj4string) from the sp package
- contains = 'Spatial',
representation (
+ bbox = 'BoundingBox',
ncols ='integer',
- nrows ='integer'
- ),
+ nrows ='integer',
+ crs = 'CRS'
+ ),
prototype (
ncols= as.integer(1),
- nrows= as.integer(1)
+ nrows= as.integer(1),
+ crs = CRS(as.character(NA))
),
validity = function(object)
{
@@ -47,8 +48,6 @@
return(c1 & c2)
}
)
-
-
@@ -102,7 +101,7 @@
prototype (
values=vector(),
content='nodata',
- indices =vector(mode='numeric'),
+ indices = vector(mode='numeric'),
haveminmax = FALSE,
min = numeric(0),
max = numeric(0),
Modified: pkg/raster/R/brick.create.R
===================================================================
--- pkg/raster/R/brick.create.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/brick.create.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -6,13 +6,12 @@
}
brickFromBbox <- function(bndbox, nrows=1, ncols=1, projstring="") {
- bndbox <- boundingbox(bndbox)
nrows = as.integer(round(nrows))
ncols = as.integer(round(ncols))
if (ncols < 1) { stop("ncols should be > 0") }
if (nrows < 1) { stop("nrows should be > 0") }
- proj4string <- newCRS(projstring)
- brick <- new("RasterBrick", bbox = bndbox, proj4string=proj4string, ncols = ncols, nrows = nrows )
+ crs <- newCRS(projstring)
+ brick <- new("RasterBrick", bbox = getBbox(bndbox), crs=crs, ncols = ncols, nrows = nrows )
return(brick)
}
Modified: pkg/raster/R/compare.R
===================================================================
--- pkg/raster/R/compare.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/compare.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -17,7 +17,7 @@
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 )))) {
+ if (!(isTRUE(all.equal(getBbox(objects[[1]]), getBbox(objects[[i]]), tolerance=tolerance, scale=minres )))) {
result <- F
if (stopiffalse) { stop('Different bounding box') }
if (showwarning) { warning('Different bounding box') }
Modified: pkg/raster/R/conversion.R
===================================================================
--- pkg/raster/R/conversion.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/conversion.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -25,11 +25,16 @@
return(object)
} else if (class(object) == 'RasterBrick' | class(object) == 'RasterStack') {
rs <- newRaster(xmn = xmin(object), xmx = xmax(object), ymn = ymin(object), ymx = ymax(object), nrows=nrow(object), ncols=ncol(object), projstring=projection(object))
+ if (dataContent(object) == 'all') {
+ dindex <- max(1, min(nlayers(object), dataindex))
+ if (dindex != dataindex) { warning(paste("dataindex was changed to", dindex))}
+ rs <- setValues(rs, values(object, format='matrix')[,dindex])
+ }
return(rs)
} else { # assuming an SP raster
raster <- newRaster()
- raster at bbox <- object at bbox
- raster at proj4string <- object at proj4string
+ raster at bbox <- getBbox(object)
+ raster at crs <- object at proj4string
raster at ncols <- object at grid@cells.dim[1]
raster at nrows <- object at grid@cells.dim[2]
if (class(object)=='SpatialPixels') {
@@ -40,11 +45,13 @@
if (length(cells)==0) {
cells <- cellFromXY(raster, object at coords)
}
+# if (dindex != dataindex) { warning(paste("dataindex was changed to", dindex))}
vals <- object at data[[dataindex]]
raster <- setValuesSparse(raster, cells, vals)
} else if ( class(object)=='SpatialGrid' ) {
# do nothing, there is no data
} else if (class(object)=='SpatialGridDataFrame' ) {
+# if (dindex != dataindex) { warning(paste("dataindex was changed to", dindex))}
raster <- setValues(raster, object at data[[dataindex]])
}
return(raster)
@@ -55,7 +62,7 @@
asRasterBrick <- function(spgrid) {
brick <- newBrick()
brick at bbox <- spgrid at bbox
- brick at proj4string <- spgrid at proj4string
+ brick at crs <- spgrid at proj4string
brick at ncols <- spgrid at grid@cells.dim[1]
brick at nrows <- spgrid at grid@cells.dim[2]
if (class(spgrid)=='SpatialPixels') {
@@ -77,8 +84,20 @@
}
+.toSpBbox <- function(object) {
+ b <- getBbox(object)
+ bb <- matrix(NA, 2, 2)
+ bb[1,1] <- b at xmin
+ bb[1,2] <- b at xmax
+ bb[2,1] <- b at ymin
+ bb[2,2] <- b at ymax
+ return(bb)
+}
+
+
+
asSpGrid <- function(raster, type='grid') {
- bb <- boundingbox(raster)
+ bb <- .toSpBbox(raster)
cs <- resolution(raster)
cc <- bb[,1] + (cs/2)
cd <- ceiling(diff(t(bb))/cs)
Modified: pkg/raster/R/crop.R
===================================================================
--- pkg/raster/R/crop.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/crop.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -12,27 +12,16 @@
#}
+
crop <- function(raster, bndbox, filename="", overwrite=FALSE) {
# we could also allow the raster to expand but for now let's not and first make a separate expand function
- bb <- boundingbox(bndbox)
-
- xmn <- max(bb[1,1], xmin(raster))
- xmx <- min(bb[1,2], xmax(raster))
- ymn <- max(bb[2,1], ymin(raster))
- ymx <- min(bb[2,2], ymax(raster))
-
- if (xmn > xmx | ymn > ymx) {stop("boundingbox is entirely outside of raster")}
-
- if (xmn == xmx) {stop("xmin and xmax are less than one cell apart")}
- if (ymn == ymx) {stop("ymin and ymax are less than one cell apart")}
-
+ bb <- .innerBox(c(raster, bndbox))
outraster <- setRaster(raster, filename)
- bndbox <- newBbox(xmn, xmx, ymn, ymx)
- outraster <- setBbox(outraster, bndbox, keepres=T)
+ outraster <- setBbox(outraster, bb, keepres=T)
if (dataContent(raster) == 'all') {
- first_start_cell <- cellFromXY(raster, c(xmn + 0.5 * xres(raster), ymx - 0.5 * yres(raster) ))
- last_start_cell <- cellFromXY(raster, c(xmn + 0.5 * xres(raster), ymn + 0.5 * yres(raster) ))
+ first_start_cell <- cellFromXY(raster, c(xmin(outraster) + 0.5 * xres(raster), ymax(outraster) - 0.5 * yres(raster) ))
+ last_start_cell <- cellFromXY(raster, c(xmin(outraster) + 0.5 * xres(raster), ymin(outraster) + 0.5 * yres(raster) ))
start_cells <- seq(first_start_cell, last_start_cell, by = ncol(raster))
end_cells <- start_cells + ncol(outraster) - 1
selected_cells <- as.vector(mapply(seq, start_cells, end_cells))
@@ -44,8 +33,8 @@
} else if ( dataSource(raster) == 'disk') {
- first_col <- colFromX(raster, xmn + 0.5 * xres(outraster))
- first_row <- rowFromY(raster, ymx - 0.5 * yres(outraster))
+ first_col <- colFromX(raster, xmin(outraster) + 0.5 * xres(outraster))
+ first_row <- rowFromY(raster, ymax(outraster) - 0.5 * yres(outraster))
last_row <- first_row + nrow(outraster) - 1
rownr <- 1
v <- vector(length=0)
Modified: pkg/raster/R/expand.R
===================================================================
--- pkg/raster/R/expand.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/expand.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -8,13 +8,13 @@
expand <- function(raster, bndbox, filename="", overwrite=FALSE) {
- bndbox <- boundingbox(bndbox)
+ bndbox <- getBbox(bndbox)
res <- resolution(raster)
# snap points to pixel boundaries
- xmn <- round(bndbox[1,1] / res[1]) * res[1]
- xmx <- round(bndbox[1,2] / res[1]) * res[1]
- ymn <- round(bndbox[2,1] / res[2]) * res[2]
- ymx <- round(bndbox[2,2] / res[2]) * res[2]
+ xmn <- round(bndbox at xmin / res[1]) * res[1]
+ xmx <- round(bndbox at xmax / res[1]) * res[1]
+ ymn <- round(bndbox at ymin / res[2]) * res[2]
+ ymx <- round(bndbox at ymax / res[2]) * res[2]
# only expanding here, not cutting
xmn <- min(xmn, xmin(raster))
Modified: pkg/raster/R/map.R
===================================================================
--- pkg/raster/R/map.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/map.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -42,7 +42,7 @@
xmx <- xmax(object) - (ncol(object) - cols[length(cols)]) * xres(object)
ymn <- ymin(object) + (nrow(object) - rows[length(rows)]) * yres(object)
bndbox <- changeBbox(object, xmx=xmx, ymn=ymn)
- object <- setBbox(sampraster, bndbox)
+ object <- setBbox(sampraster, bndbox, keepres=F)
} else {
m <- values(object, format='matrix')
subsample=FALSE
@@ -67,13 +67,6 @@
.imageplot(x, y, z, col=col, axes = TRUE, xlab=xlab, ylab=ylab, ...)
if (addbox) {box()}
-# image(x, y, z, col=col, axes = FALSE, xlab="", ylab="")
-# contour(x, y, z, add = TRUE, col = "peru")
-# xincr <- (object at xmax - object at xmin) / 12
-# yincr <- (object at ymax - object at ymin) / 10
-# axis(1, at = seq(object at xmin, object at xmax, by = xincr))
-# axis(2, at = seq(object at ymin, object at ymax, by = yincr))
-# title(main = object at file@shortname, font.main = 4)
}
@@ -82,7 +75,7 @@
# The functions below were taken from the fields package !!! (image.plot and subroutines)
-# to be adjusted for object.
+# to be adjusted for the RasterLayer object.
# author::
#license:
Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/properties.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -14,29 +14,25 @@
}
xmin <- function(object) {
- return(as.numeric(object at bbox[1,1]))
+ object <- getBbox(object)
+ return(as.numeric(object at xmin))
}
xmax <- function(object) {
- return(as.numeric(object at bbox[1,2]))
+ object <- getBbox(object)
+ return(as.numeric(object at xmax))
}
ymin <- function(object) {
- return(as.numeric( object at bbox[2,1]) )
+ object <- getBbox(object)
+ return(as.numeric( object at ymin))
}
ymax <- function(object) {
- return(as.numeric(object at bbox[2,2]))
+ object <- getBbox(object)
+ return(as.numeric(object at ymax))
}
-.zmin <- function(object) {
- return (object at bbox[3,1])
-}
-
-.zmax <- function(object) {
- return (object at bbox[3,2])
-}
-
xres <- function(object) {
return ( as.numeric( (xmax(object) - xmin(object)) / ncol(object)) )
}
@@ -51,18 +47,7 @@
return(c(x, y))
}
-boundingbox <- function(object) {
- if (class(object) != "matrix") {
- b <- bbox(object)[1:2, 1:2]
- } else {
- b <- object[1:2, 1:2]
- }
- rownames(b) <- c("x", "y")
- colnames(b) <- c("min", "max")
- return(b)
-}
-
nlayers <- function(object) {
if (class(object) == "RasterLayer") {
return(1)
@@ -104,13 +89,13 @@
projection <- function(object, asText=TRUE) {
if (asText) {
- if (is.na(object at proj4string@projargs)) {
+ if (is.na(object at crs@projargs)) {
return("NA")
} else {
- return(object at proj4string@projargs)
+ return(object at crs@projargs)
}
} else {
- return(object at proj4string)
+ return(object at crs)
}
}
Modified: pkg/raster/R/raster.create.R
===================================================================
--- pkg/raster/R/raster.create.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/raster.create.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -11,13 +11,13 @@
}
rasterFromBbox <- function(bndbox, nrows=1, ncols=1, projstring="") {
- bndbox <- boundingbox(bndbox)
+ bndbox <- getBbox(bndbox)
nr = as.integer(round(nrows))
nc = as.integer(round(ncols))
if (nc < 1) { stop("ncols should be > 0") }
if (nr < 1) { stop("nrows should be > 0") }
- proj4string <- newCRS(projstring)
- raster <- new("RasterLayer", bbox = bndbox, proj4string=proj4string, ncols = nc, nrows = nr )
+ crs <- newCRS(projstring)
+ raster <- new("RasterLayer", bbox = bndbox, crs=crs, ncols = nc, nrows = nr )
return(raster)
}
Modified: pkg/raster/R/raster.read.R
===================================================================
--- pkg/raster/R/raster.read.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/raster.read.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -195,7 +195,7 @@
xmx <- xmax(raster) - (ncol(raster) - cols[nc]) * xres(raster)
ymn <- ymin(raster) + (nrow(raster) - row) * yres(raster)
bndbox <- changeBbox(raster, xmx=xmx, ymn=ymn)
- outras <- setBbox(outras, bndbox)
+ outras <- setBbox(outras, bndbox, keepres=F)
outras <- setValues(outras, dd)
}
if (asRaster) {
Modified: pkg/raster/R/set.R
===================================================================
--- pkg/raster/R/set.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/set.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -61,9 +61,9 @@
setProjection <- function(object, projstring) {
if (class(projstring)=="CRS") {
- object at proj4string <- projstring
+ object at crs <- projstring
} else {
- object at proj4string <- newCRS(projstring)
+ object at crs <- newCRS(projstring)
}
return(object)
}
@@ -83,10 +83,10 @@
roundCoords <- function(object, digits=0) {
digits <- max(0, digits)
- object at bbox[1,1] <- round(object at bbox[1,1], digits)
- object at bbox[1,2] <- round(object at bbox[1,2], digits)
- object at bbox[2,1] <- round(object at bbox[2,1], digits)
- object at bbox[2,2] <- round(object at bbox[2,2], digits)
+ object at bbox@xmin <- round(object at bbox@xmin, digits)
+ object at bbox@xmax <- round(object at bbox@xmax, digits)
+ object at bbox@ymin <- round(object at bbox@ymin, digits)
+ object at bbox@ymax <- round(object at bbox@ymax, digits)
return(object)
}
@@ -114,49 +114,57 @@
}
-.newSpatial <- function(xmn, xmx, ymn, ymx, projstring='') {
- if (xmn > xmx) {
- x <- xmn
- xmn <- xmx
- xmx <- x
- }
- if (ymn > ymx) {
- y <- ymn
- ymn <- ymx
- ymx <- y
- }
- projs <- newCRS(projstring)
- bb <- new("Spatial")
- bb at bbox[1,1] <- xmn
- bb at bbox[1,2] <- xmx
- bb at bbox[2,1] <- ymn
- bb at bbox[2,2] <- ymx
- bb at bbox[3,1] <- 0
- bb at bbox[3,2] <- 1
- bb at proj4string <- projs
+newBbox <- function(xmn, xmx, ymn, ymx) {
+ bb <- new('BoundingBox')
+ bb at xmin <- xmn
+ bb at xmax <- xmx
+ bb at ymin <- ymn
+ bb at ymax <- ymx
return(bb)
}
-newBbox <- function(xmn, xmx, ymn, ymx) {
- sp <- .newSpatial(xmn, xmx, ymn, ymx)
- bb <- boundingbox(sp)
+getBbox <- function(object) {
+ if ( class(object) == 'BoundingBox' ) {
+ bb <- object
+ } else if ( class(object) == 'RasterLayer' | class(object) == 'RasterStack' | class(object) == 'RasterBrick' ) {
+ bb <- object at bbox
+ } else if (class(object) == "matrix") {
+ bb <- new('BoundingBox')
+ bb at xmin <- object[1,1]
+ bb at xmax <- object[1,2]
+ bb at ymin <- object[2,1]
+ bb at ymax <- object[2,2]
+ } else if (class(object) == "vector") {
+ bb <- new('BoundingBox')
+ bb at xmin <- object[1]
+ bb at xmax <- object[2]
+ bb at ymin <- object[3]
+ bb at ymax <- object[4]
+ } else {
+ bndbox <- bbox(object)
+ bb <- new('BoundingBox')
+ bb at xmin <- bndbox[1,1]
+ bb at xmax <- bndbox[1,2]
+ bb at ymin <- bndbox[2,1]
+ bb at ymax <- bndbox[2,2]
+ }
return(bb)
}
setBbox <- function(object, bndbox, keepres=FALSE) {
- bndbox <- boundingbox(bndbox)
xrs <- xres(object)
yrs <- yres(object)
- object at bbox[1,1] <- bndbox[1,1]
- object at bbox[1,2] <- bndbox[1,2]
- object at bbox[2,1] <- bndbox[2,1]
- object at bbox[2,2] <- bndbox[2,2]
+ object at bbox <- getBbox(bndbox)
if (keepres) {
- object at ncols <- as.integer(round( (xmax(object) - xmin(object)) / xrs ))
- object at nrows <- as.integer(round( (ymax(object) - ymin(object)) / xrs ))
- object at bbox[1,2] <- object at bbox[1,1] + ncol(object) * xrs
- object at bbox[2,2] <- object at bbox[2,1] + nrow(object) * yrs
+ nc <- as.integer(round( (xmax(object) - xmin(object)) / xrs ))
+ if (nc < 1) { stop( "xmin and xmax are less than one cell apart" )
+ } else { object at ncols <- nc }
+ nr <- as.integer(round( (ymax(object) - ymin(object)) / xrs ) )
+ if (nr < 1) { stop( "ymin and ymax are less than one cell apart" )
+ } else { object at nrows <- nr }
+ object at bbox@xmax <- object at bbox@xmin + ncol(object) * xrs
+ object at bbox@ymax <- object at bbox@ymin + nrow(object) * yrs
}
return(object)
}
Modified: pkg/raster/R/standard.generic.functions.R
===================================================================
--- pkg/raster/R/standard.generic.functions.R 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/R/standard.generic.functions.R 2009-01-10 16:06:50 UTC (rev 113)
@@ -78,7 +78,7 @@
}
}
)
-
+
setMethod("Arith", signature(e1='RasterLayer', e2='RasterLayer'),
function(e1, e2){
if (compare(c(e1, e2))) {
Modified: pkg/raster/man/bbox.Rd
===================================================================
--- pkg/raster/man/bbox.Rd 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/man/bbox.Rd 2009-01-10 16:06:50 UTC (rev 113)
@@ -1,4 +1,5 @@
-\name{boundingbox}
+\name{box}
+\alias{getBbox}
\alias{newBbox}
\alias{setBbox}
\alias{changeBbox}
@@ -12,6 +13,7 @@
}
\usage{
+getBbox(object)
newBbox(xmn, xmx, ymn, ymx)
setBbox(object, bndbox, keepres=FALSE)
changeBbox(object, xmn=xmin(object), xmx=xmax(object), ymn=ymin(object), ymx = ymax(object), keepres=FALSE)
@@ -23,7 +25,7 @@
\item{ymn}{ the minimum y coordinate of the bounding box }
\item{ymx}{ the maximum y coordinate of the bounding box }
\item{object} {A Raster* object }
- \item{bndbox}{ a bounding box object (which you can create with newBbox() ) }
+ \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}
}
Modified: pkg/raster/man/properties.Rd
===================================================================
--- pkg/raster/man/properties.Rd 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/man/properties.Rd 2009-01-10 16:06:50 UTC (rev 113)
@@ -13,7 +13,6 @@
\alias{ymin}
\alias{ymax}
\alias{projection}
-\alias{boundingbox}
\alias{origin}
\alias{nlayers}
\alias{layers}
@@ -23,8 +22,7 @@
\title{ RasterLayer 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)
- use bbox() (form sp) to get the bounding box of a raster type object.
+ 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)
}
@@ -41,7 +39,6 @@
ymin(object)
ymax(object)
projection(object, asText=TRUE)
-boundingbox(object)
origin(object)
nlayers(object)
layers(object)
@@ -83,7 +80,6 @@
ymax(rs)
projection(rs)
origin(rs)
-boundingbox(rs)
nbands(rs)
band(rs)
}
Modified: pkg/raster/man/raster.change.Rd
===================================================================
--- pkg/raster/man/raster.change.Rd 2009-01-10 10:31:31 UTC (rev 112)
+++ pkg/raster/man/raster.change.Rd 2009-01-10 16:06:50 UTC (rev 113)
@@ -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, tolerance=0.0001, filename="", overwrite=FALSE)
+Merge(rasters, tolerance=0.05, filename="", overwrite=FALSE)
}
\arguments{
@@ -28,12 +28,12 @@
\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{tolerance}{ }
+ \item{tolerance} { difference permissable (relative to the cell resolution) for objects to be 'equal'. See ?all.equal }
}
\details{
Objects that have bounding boxes include RasterLayer, and other objects descending from the Spatial class in the sp package.
- You can check this with boundingbox(object)
+ You can check this with getBbox(object)
They can be created with the function newBbox
In aggregation \code{fact = 2} will result in a grid with 2 x 2 = 4 times fewer cells, while in disaggregation 4 times more cells will be created.
In disaggregation fact can be a single integer or two integers c(x,y), in which case the first one is the horizontal disaggregation factor and y the vertical disaggreation factor
More information about the Raster-commits
mailing list