[Raster-commits] r317 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 6 12:48:08 CET 2009
Author: rhijmans
Date: 2009-03-06 12:48:07 +0100 (Fri, 06 Mar 2009)
New Revision: 317
Added:
pkg/raster/R/calcStack.R
pkg/raster/R/calcStackMultFunctions.R
pkg/raster/R/overlayStack.R
pkg/raster/R/replacement2.R
pkg/raster/R/singleIndex.R
pkg/raster/R/validCell.R
pkg/raster/R/xyCell.R
pkg/raster/man/validCell.Rd
pkg/raster/man/xyFromCell.Rd
Removed:
pkg/raster/R/mCalc.R
pkg/raster/R/sCalc.R
pkg/raster/R/sOverlay.R
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/get.R
pkg/raster/R/raster.create.R
pkg/raster/R/readRandom.R
pkg/raster/R/replacement.R
pkg/raster/R/values.R
pkg/raster/man/RasterLayer-class.Rd
pkg/raster/man/Replace-methods.Rd
pkg/raster/man/distance.Rd
pkg/raster/man/get.Rd
pkg/raster/man/raster.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/DESCRIPTION 2009-03-06 11:48:07 UTC (rev 317)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.9-2
-Date: 5-March-2009
+Version: 0.8.9-3
+Date: 6-March-2009
Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
Author: Robert J. Hijmans & Jacob van Etten
Maintainer: Robert J. Hijmans <r.hijmans at gmail.com>
Added: pkg/raster/R/calcStack.R
===================================================================
--- pkg/raster/R/calcStack.R (rev 0)
+++ pkg/raster/R/calcStack.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,54 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+#mCalc <- function(...) { stop('mCalc has been replaced by generic function "calc"')}
+
+setMethod('calc', signature(x='RasterStack', fun='function'),
+function(x, fun, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
+ if (length(fun(seq(1:5))) > 1) {
+ stop("function 'fun' returns more than one value")
+ }
+ filename <- trim(filename)
+ outraster <- setRaster(x, filename)
+ outraster <- setDatatype(outraster, datatype)
+ if (dataContent(x) == "all") {
+ outraster <- setValues(outraster, apply(values(x), 1, fun))
+ if (filename != "") {
+ outRaster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
+ }
+ } else {
+ starttime <- proc.time()
+ if (!.CanProcessInMemory(x, 4) & filename == '') {
+ filename=tempfile()
+ outraster <- setFilename(outraster, filename )
+ }
+ v <- vector(length=0)
+ for (r in 1:nrow(x)) {
+ x <- readRow(x, r)
+ if (filename(outraster)=="") {
+ v <- c(v, apply(values(x), 1, fun))
+ } else {
+ outraster <- setValues(outraster, apply(values(x), 1, fun), r)
+ outraster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
+ }
+
+ if (r %in% track) {
+ elapsed <- (proc.time() - starttime)[3]
+ tpr <- elapsed /r
+ ttg <- round(tpr/60 * (nrow(x) - r), digits=1)
+ cat('row', r, '-', ttg, 'minutes to go\n')
+ }
+
+ }
+ if (filename(outraster) == "") {
+ outraster <- setValues(outraster, v)
+ }
+ }
+ return(outraster)
+}
+)
+
Added: pkg/raster/R/calcStackMultFunctions.R
===================================================================
--- pkg/raster/R/calcStackMultFunctions.R (rev 0)
+++ pkg/raster/R/calcStackMultFunctions.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,8 @@
+
+setMethod('calc', signature(x='RasterStack', fun='list'),
+function(x, fun, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
+
+ warning('not implemented yet')
+
+}
+)
Modified: pkg/raster/R/get.R
===================================================================
--- pkg/raster/R/get.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/get.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -1,7 +1,7 @@
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
# Date : October 2008
-# Version 0,2
+# Version 0.8
# Licence GPL v3
@@ -12,24 +12,7 @@
return(FALSE)
}
}
-
-yFromRow <- function(object, rownr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- rownr <- round(rownr)
- rownr[rownr < 1 | rownr > nrow(object)] <- NA
- y <- ymax(object) - ((rownr-0.5) * yres(object))
- #hello
- return(y) }
-
-xFromCol <- function(object, colnr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- colnr <- round(colnr)
- colnr[colnr < 1 | colnr > ncol(object)] <- NA
- x <- xmin(object) + (colnr - 0.5) * xres(object)
- return(x) }
-
-
rowFromCell <- function(object, cell) {
if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
cell <- round(cell)
@@ -39,20 +22,25 @@
}
-cellsFromRow <- function(object, rownr) {
+cellFromRow <- 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) {
+cellFromCol <- 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))
}
+cellFromRowColCombine <- function(object, rownr, colnr) {
+ rows <- cellFromRow(object, rownr)
+ cols <- cellFromCol(object, colnr)
+ return(intersect(rows, cols))
+}
colFromCell <- function(object, cell) {
if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
@@ -63,30 +51,6 @@
return(colnr)
}
-cellFromXY <- function(object, xy) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- if (class(xy) == 'SpatialPoints' | class(xy) == 'SpatialPointsDataFrame') {
- x <- coordinates(xy)[,1]
- y <- coordinates(xy)[,2]
- } else if (is.null(dim(xy))) {
- x <- xy[1]
- y <- xy[2]
- } else {
- x <- xy[,1]
- y <- xy[,2]
- }
- cell <- vector(mode = "integer", length = length(x))
- cell[] <- NA
- 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))) {
- cell[i] <- rownr * ncol(object) + colnr + 1
- }
- }
- return(cell)
-}
-
cellFromRowCol <- function(object, rownr, colnr) {
if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
rownr <- round(rownr)
@@ -96,73 +60,3 @@
return((rownr-1) * ncol(object) + colnr)
}
-colFromX <- function ( object, x ) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- if (class(x) == 'SpatialPoints' | class(x) == 'SpatialPointsDataFrame') { x <- x at points[,1] }
- colnr <- (trunc((x - xmin(object)) / xres(object))) + 1
- colnr[x == xmax(object)] <- ncol(object)
- colnr[x < xmin(object) | x > xmax(object) ] <- NA
- return(as.vector(colnr))
-}
-
-
-rowFromY <- function ( object, y ) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- if (class(y) == 'SpatialPoints' | class(y) == 'SpatialPointsDataFrame') { y <- y at points[,2] }
- rownr <- 1 + (trunc((ymax(object) - y) / yres(object)))
- rownr[y == ymin(object) ] <- nrow(object)
- rownr[y > ymax(object) | y < ymin(object)] <- NA
- return(rownr)
-}
-
-
-xyFromCell <- function(object, cell, asSpatialPoints=FALSE) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- cell <- round(cell)
- xy <- matrix(data = NA, ncol=2, nrow=length(cell))
- colnr <- colFromCell(object, cell)
- rownr <- rowFromCell(object, cell)
- xy[,1] <- xFromCol(object, colnr)
- xy[,2] <- yFromRow(object, rownr)
- colnames(xy) <- c("x", "y")
- if (asSpatialPoints) {
- xy <- SpatialPoints(xy, projection(object, asText=FALSE))
- }
- return(xy)
-}
-
-
-
-cxyFromBbox <- function(object, bbox) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- bbox <- getBbox(bbox)
- cells <- cellsFromBbox(object, bbox)
- cxy <- cbind(cells, xyFromCell(object, cells))
- colnames(cxy) <- c("cell", "x", "y")
- return(cxy)
-}
-
-
-validCells <- function(object, cell) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- cell <- round(cell)
- validcell <- vector(length=length(cell))
- validcell[cell > 0 & cell <= ncell(object)] <- TRUE
- return(validcell)
-}
-
-validRows <- function(object, rownr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- rownr <- round(rownr)
- validrows <- vector(length=length(rownr))
- validrows[rownr > 0 & rownr <= nrow(object)] <- TRUE
- return(validrows)
-}
-
-validCols <- function(object, colnr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
- colnr <- round(colnr)
- validcols <- vector(length=length(colnr))
- validcols[colnr > 0 & colnr <= nrow(object)] <- TRUE
- return(validcols)
-}
Deleted: pkg/raster/R/mCalc.R
===================================================================
--- pkg/raster/R/mCalc.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/mCalc.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -1,54 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0.8
-# Licence GPL v3
-
-
-#mCalc <- function(...) { stop('mCalc has been replaced by generic function "calc"')}
-
-setMethod('calc', signature(x='RasterStack', fun='function'),
-function(x, fun, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
- if (length(fun(seq(1:5))) > 1) {
- stop("function 'fun' returns more than one value")
- }
- filename <- trim(filename)
- outraster <- setRaster(x, filename)
- outraster <- setDatatype(outraster, datatype)
- if (dataContent(x) == "all") {
- outraster <- setValues(outraster, apply(values(x), 1, fun))
- if (filename != "") {
- outRaster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
- }
- } else {
- starttime <- proc.time()
- if (!.CanProcessInMemory(x, 4) & filename == '') {
- filename=tempfile()
- outraster <- setFilename(outraster, filename )
- }
- v <- vector(length=0)
- for (r in 1:nrow(x)) {
- x <- readRow(x, r)
- if (filename(outraster)=="") {
- v <- c(v, apply(values(x), 1, fun))
- } else {
- outraster <- setValues(outraster, apply(values(x), 1, fun), r)
- outraster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
- }
-
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(x) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
-
- }
- if (filename(outraster) == "") {
- outraster <- setValues(outraster, v)
- }
- }
- return(outraster)
-}
-)
-
Added: pkg/raster/R/overlayStack.R
===================================================================
--- pkg/raster/R/overlayStack.R (rev 0)
+++ pkg/raster/R/overlayStack.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,41 @@
+# Author: Robert J. Hijmans and Reinhard Krug
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+setMethod('overlay', signature(x='RasterStack', y='missing'),
+function(x, y, fun, indices=1:nlayers(x), filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1){
+
+ indices <- round(indices)
+ if (min(indices) < 1) { stop('indices should be >= 1') }
+ if (max(indices) > nlayers(x)) { stop('indices should be <= nlayers(x)') }
+
+ rasters <- list()
+ for (i in 1:length(indices)) {
+ rasters[i] <- asRasterLayer(x, indices[i])
+ }
+
+ if (missing(fun)) {
+ stop("you must supply a function 'fun'. E.g., 'fun=function(x,y){return(x+y)}'")
+ }
+
+ if (length(fun) == 1) {
+ return(overlay(rasters, fun=fun, overwrite=overwrite, filetype=filetype, datatype=datatype, track=track))
+ } else {
+ if (filename != "" && (length(filename) != length(fun)) ) {
+ stop('you must provide a filename for each function if you provide multiple functions')
+ }
+
+ # the idea is to optimize this, by reading all (row) data only once....
+ res <- list()
+ for (i in 1:length(fun)) {
+ res[i] <- (overlay(rasters, fun=fun, overwrite=overwrite, filetype=filetype, datatype=datatype, track=track))
+ }
+ return(res)
+ }
+}
+)
+
Modified: pkg/raster/R/raster.create.R
===================================================================
--- pkg/raster/R/raster.create.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/raster.create.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -22,7 +22,7 @@
# return(raster(xmn, xmx, ymn, ymx, nrows, ncols, projstring)) }
-raster <- function(xmn=-180, xmx=180, ymn=-90, ymx=90, nrows=180, ncols=360, projstring="+proj=longlat +datum=WGS84") {
+raster <- function(nrows=180, ncols=360, xmn=-180, xmx=180, ymn=-90, ymx=90, projstring="+proj=longlat +datum=WGS84") {
bb <- newBbox(xmn, xmx, ymn, ymx)
rs <- rasterFromBbox(bb, nrows=nrows, ncols=ncols)
rs <- setProjection(rs, projstring)
Modified: pkg/raster/R/readRandom.R
===================================================================
--- pkg/raster/R/readRandom.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/readRandom.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -4,10 +4,6 @@
# Version 0.8
# Licence GPL v3
-
-
-#sample while reading and return matrix (for plotting )
-
sampleRandom <- function(raster, n=500, na.rm = TRUE) {
if (dataContent(raster) == 'all') {
values <- values(raster)
@@ -45,60 +41,3 @@
}
-
-sampleSkip <- function(raster, maxdim=500, bndbox=NA, asRaster=FALSE) {
- if (!(is.na(bndbox))) {
- rcut <- crop(raster, bndbox)
- warning('bndbox option has not been implemented yet')
- } else {
- rcut <- setRaster(raster)
- }
- # Need to do something with this now.....
-
- rasdim <- max(ncol(raster), nrow(raster) )
- if (rasdim <= maxdim) {
- if (dataContent(raster) == 'all') {
- outras <- raster
- } else {
- outras <- readAll(raster)
- }
- } else {
- fact <- maxdim / rasdim
- nc <- max(1, trunc(fact * ncol(raster)))
- nr <- max(1, trunc(fact * nrow(raster)))
- colint <- round(ncol(raster) / nc)
- rowint <- round(nrow(raster) / nr)
- nc <- trunc(ncol(raster) / colint)
- nr <- trunc(nrow(raster) / rowint)
- cols <- 1:nc
- cols <- 1 + (cols-1) * colint
- dd <- vector()
- if (dataContent(raster) == 'all') {
- for (i in 1:nr) {
- row <- 1 + (i-1) * rowint
- v <- values(raster, row)
- dd <- c(dd, v[cols])
- }
- } else {
- for (i in 1:nr) {
- row <- 1 + (i-1) * rowint
- raster <- readRow(raster, row)
- dd <- c(dd, values(raster)[cols])
- }
- }
- }
- if (asRaster) {
- outras <- setRaster(raster)
- outras <- setRowCol(outras, nr, nc)
- xmx <- xmax(raster) - (ncol(raster) - cols[nc]) * xres(raster)
- ymn <- ymin(raster) + (nrow(raster) - row) * yres(raster)
- bndbox <- changeExtent(raster, xmx=xmx, ymn=ymn)
- outras <- setExtent(outras, bndbox, keepres=F)
- outras <- setValues(outras, dd)
- return(outras)
- } else {
- return(dd)
- }
-}
-
-
Modified: pkg/raster/R/replacement.R
===================================================================
--- pkg/raster/R/replacement.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/replacement.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -6,75 +6,31 @@
-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')
+setReplaceMethod("[", c("RasterLayer", "ANY", "missing"),
+ function(x, i, j, value) {
+ 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 {
- if (.CanProcessInMemory(x, 1)) {
- x <- readAll(x)
- }
+ stop('length of replacement values should be 1 or ncell')
}
}
- 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 {
- 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("[", c("RasterLayer","missing", "missing"),
- function(x, i, j, value) {
- 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) )
}
# what about data rows ?
if (dataContent(x) == 'nodata') {
- if (ncell(x) < 1000000) {
+ if (.CanProcessInMemory(x, 2)) {
if (dataSource(x) == 'disk') {
x <- readAll(x)
} else {
x <- setValues(x, rep(NA, times=ncell(x)))
}
} else {
- stop('Large raster with no data in memory, use readAll() first')
+ stop('raster too large.')
}
}
x at data@values[i] <- value
@@ -86,39 +42,3 @@
)
-
-setReplaceMethod("[[", "RasterLayer",
- function(x, i, j, value) {
- if (!missing(i)) {
- if (class(i) == "RasterLayer") {
- i <- as.logical( .getRasterValues(i) )
- }
- }
- if (!missing(j)) {
- if (class(j) == "RasterLayer") {
- j <- as.logical( .getRasterValues(i) )
- }
- }
-
- if (dataContent(x) == 'nodata') {
- if (ncell(x) < 1000000) {
- if (dataSource(x) == 'disk') {
- x <- readAll(x)
- } else {
- x <- setValues(x, rep(NA, times=ncell(x)))
- }
- } else {
- stop('Large raster with no data in memory, use readAll() first')
- }
- }
- v <- matrix(values(x), nrow(x), ncol(x), byrow=T)
- x <- clearValues(x)
- v[i,j] <- value
- x <- setValues(x, as.vector(t(v)))
- x <- setFilename(x, "")
- x <- setMinMax(x)
- return(x)
- }
-)
-
-
Added: pkg/raster/R/replacement2.R
===================================================================
--- pkg/raster/R/replacement2.R (rev 0)
+++ pkg/raster/R/replacement2.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,52 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+
+setMethod("[[", c("RasterLayer","ANY", "ANY"),
+function(x,i,j,...,drop=TRUE) {
+
+ if (!missing(i) && class(i) == "RasterLayer") {
+ i <- as.logical( .getRasterValues(i) )
+ }
+
+ if (dataContent(x) != 'all') {
+ if (dataSource(x) != 'disk') {
+ stop('no data associated with this RasterLayer object')
+ } else {
+ if (.CanProcessInMemory(x, 1)) {
+ x <- readAll(x)
+ }
+ }
+ }
+
+ if (dataContent(x) == 'all') {
+ m <- matrix(values(x), nrow(x), ncol(x), byrow=T)
+ rm(x)
+# callNextMethod(m, i=i, j=j, drop=drop)
+ return(m[i=i, j=j, drop=drop])
+ } else {
+ if ( missing(j) ) {
+ #argsn <- nargs() - length(list(...)) - !missing(drop)
+ #if ( argsn == 2 ) {
+ # return(cellValues(x, i))
+ #} else {
+ cells <- cellFromRow(x, i)
+ return(cellValues(x, cells))
+ #}
+ } else if (missing(i)) {
+ cells <- cellFromCol(x, j)
+ return(cellValues(x, cells))
+ } else {
+ # bound to fail in most cases:
+ cells <- cellFromRowColCombine(x, i, j)
+ return(cellValues(x, cells))
+ }
+
+ }
+}
+)
+
Deleted: pkg/raster/R/sCalc.R
===================================================================
--- pkg/raster/R/sCalc.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/sCalc.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -1,8 +0,0 @@
-
-setMethod('calc', signature(x='RasterStack', fun='list'),
-function(x, fun, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
-
- warning('not implemented yet')
-
-}
-)
Deleted: pkg/raster/R/sOverlay.R
===================================================================
--- pkg/raster/R/sOverlay.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/sOverlay.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -1,41 +0,0 @@
-# Author: Robert J. Hijmans and Reinhard Krug
-# International Rice Research Institute
-# Date : June 2008
-# Version 0.8
-# Licence GPL v3
-
-
-
-setMethod('overlay', signature(x='RasterStack', y='missing'),
-function(x, y, fun, indices=1:nlayers(x), filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1){
-
- indices <- round(indices)
- if (min(indices) < 1) { stop('indices should be >= 1') }
- if (max(indices) > nlayers(x)) { stop('indices should be <= nlayers(x)') }
-
- rasters <- list()
- for (i in 1:length(indices)) {
- rasters[i] <- asRasterLayer(x, indices[i])
- }
-
- if (missing(fun)) {
- stop("you must supply a function 'fun'. E.g., 'fun=function(x,y){return(x+y)}'")
- }
-
- if (length(fun) == 1) {
- return(overlay(rasters, fun=fun, overwrite=overwrite, filetype=filetype, datatype=datatype, track=track))
- } else {
- if (filename != "" && (length(filename) != length(fun)) ) {
- stop('you must provide a filename for each function if you provide multiple functions')
- }
-
- # the idea is to optimize this, by reading all (row) data only once....
- res <- list()
- for (i in 1:length(fun)) {
- res[i] <- (overlay(rasters, fun=fun, overwrite=overwrite, filetype=filetype, datatype=datatype, track=track))
- }
- return(res)
- }
-}
-)
-
Added: pkg/raster/R/singleIndex.R
===================================================================
--- pkg/raster/R/singleIndex.R (rev 0)
+++ pkg/raster/R/singleIndex.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,37 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+setMethod("[", c("RasterLayer","ANY", "missing"),
+function(x,i,j,...,drop=TRUE) {
+
+ if (!missing(i) && class(i) == "RasterLayer") {
+ i <- as.logical( .getRasterValues(i) )
+ }
+
+ if (dataContent(x) != 'all') {
+ if (dataSource(x) != 'disk') {
+ stop('no data associated with this RasterLayer object')
+ } else {
+ if (.CanProcessInMemory(x, 1)) {
+ x <- readAll(x)
+ }
+ }
+ }
+
+ if (dataContent(x) == 'all') {
+ callNextMethod(values(x), i=i, drop=drop )
+ } else {
+ if (missing(i)) {
+ stop('raster too large.')
+ } else {
+ return(cellValues(x, i))
+ }
+ }
+}
+)
+
+
Added: pkg/raster/R/validCell.R
===================================================================
--- pkg/raster/R/validCell.R (rev 0)
+++ pkg/raster/R/validCell.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,30 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+validCell <- function(object, cell) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ cell <- round(cell)
+ validcell <- vector(length=length(cell))
+ validcell[cell > 0 & cell <= ncell(object)] <- TRUE
+ return(validcell)
+}
+
+validRow <- function(object, rownr) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ rownr <- round(rownr)
+ validrows <- vector(length=length(rownr))
+ validrows[rownr > 0 & rownr <= nrow(object)] <- TRUE
+ return(validrows)
+}
+
+validCol <- function(object, colnr) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ colnr <- round(colnr)
+ validcols <- vector(length=length(colnr))
+ validcols[colnr > 0 & colnr <= nrow(object)] <- TRUE
+ return(validcols)
+}
Modified: pkg/raster/R/values.R
===================================================================
--- pkg/raster/R/values.R 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/R/values.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -63,7 +63,7 @@
stop('cannot get these values')
}
}
- if (!(validRows(raster, rownr))) {
+ if (!(validRow(raster, rownr))) {
stop(paste(rownr,'is not a valid rownumber'))
}
if (dataContent(raster) == 'sparse') {
Added: pkg/raster/R/xyCell.R
===================================================================
--- pkg/raster/R/xyCell.R (rev 0)
+++ pkg/raster/R/xyCell.R 2009-03-06 11:48:07 UTC (rev 317)
@@ -0,0 +1,94 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+yFromRow <- function(object, rownr) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ rownr <- round(rownr)
+ rownr[rownr < 1 | rownr > nrow(object)] <- NA
+ y <- ymax(object) - ((rownr-0.5) * yres(object))
+ #hello
+ return(y) }
+
+
+xFromCol <- function(object, colnr) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ colnr <- round(colnr)
+ colnr[colnr < 1 | colnr > ncol(object)] <- NA
+ x <- xmin(object) + (colnr - 0.5) * xres(object)
+ return(x) }
+
+
+cellFromXY <- function(object, xy) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (class(xy) == 'SpatialPoints' | class(xy) == 'SpatialPointsDataFrame') {
+ x <- coordinates(xy)[,1]
+ y <- coordinates(xy)[,2]
+ } else if (is.null(dim(xy))) {
+ x <- xy[1]
+ y <- xy[2]
+ } else {
+ x <- xy[,1]
+ y <- xy[,2]
+ }
+ cell <- vector(mode = "integer", length = length(x))
+ cell[] <- NA
+ 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))) {
+ cell[i] <- rownr * ncol(object) + colnr + 1
+ }
+ }
+ return(cell)
+}
+
+colFromX <- function ( object, x ) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (class(x) == 'SpatialPoints' | class(x) == 'SpatialPointsDataFrame') { x <- x at points[,1] }
+ colnr <- (trunc((x - xmin(object)) / xres(object))) + 1
+ colnr[x == xmax(object)] <- ncol(object)
+ colnr[x < xmin(object) | x > xmax(object) ] <- NA
+ return(as.vector(colnr))
+}
+
+
+rowFromY <- function ( object, y ) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (class(y) == 'SpatialPoints' | class(y) == 'SpatialPointsDataFrame') { y <- y at points[,2] }
+ rownr <- 1 + (trunc((ymax(object) - y) / yres(object)))
+ rownr[y == ymin(object) ] <- nrow(object)
+ rownr[y > ymax(object) | y < ymin(object)] <- NA
+ return(rownr)
+}
+
+
+xyFromCell <- function(object, cell, asSpatialPoints=FALSE) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ cell <- round(cell)
+ xy <- matrix(data = NA, ncol=2, nrow=length(cell))
+ colnr <- colFromCell(object, cell)
+ rownr <- rowFromCell(object, cell)
+ xy[,1] <- xFromCol(object, colnr)
+ xy[,2] <- yFromRow(object, rownr)
+ colnames(xy) <- c("x", "y")
+ if (asSpatialPoints) {
+ xy <- SpatialPoints(xy, projection(object, asText=FALSE))
+ }
+ return(xy)
+}
+
+
+
+cxyFromBbox <- function(object, bbox) {
+ if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ bbox <- getBbox(bbox)
+ cells <- cellsFromBbox(object, bbox)
+ cxy <- cbind(cells, xyFromCell(object, cells))
+ colnames(cxy) <- c("cell", "x", "y")
+ return(cxy)
+}
+
Modified: pkg/raster/man/RasterLayer-class.Rd
===================================================================
--- pkg/raster/man/RasterLayer-class.Rd 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/man/RasterLayer-class.Rd 2009-03-06 11:48:07 UTC (rev 317)
@@ -70,10 +70,8 @@
\section{Methods}{
\describe{
\item{!}{\code{signature(x = "RasterLayer")}: ... }
- \item{[}{\code{signature(x = "RasterLayer")}: ... }
- \item{[[}{\code{signature(x = "RasterLayer", i = "ANY", j = "ANY")}: ... }
- \item{[[<-}{\code{signature(x = "RasterLayer", i = "ANY", j = "ANY")}: ... }
- \item{[<-}{\code{signature(x = "RasterLayer")}: ... }
+ \item{[}{\code{signature(x = "RasterLayer", i = "ANY", j = "ANY")}: ... }
+ \item{[<-}{\code{signature(x = "RasterLayer", i = "ANY", j = "ANY")}: ... }
\item{aggregate}{\code{signature(x = "RasterLayer")}: ... }
\item{calc}{\code{signature(x = "RasterLayer", fun = "function")}: ... }
\item{cellValues}{\code{signature(object = "RasterLayer", cells = "vector")}: ... }
Modified: pkg/raster/man/Replace-methods.Rd
===================================================================
--- pkg/raster/man/Replace-methods.Rd 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/man/Replace-methods.Rd 2009-03-06 11:48:07 UTC (rev 317)
@@ -2,14 +2,14 @@
\docType{methods}
\alias{[,RasterLayer-method}
-\alias{[,RasterStack-method}
+\alias{[,RasterLayer,ANY,ANY-method}
+\alias{[,RasterLayer,ANY,missing-method}
+\alias{[[,RasterLayer,ANY,ANY-method}
+
+\alias{[<-,RasterLayer-method}
\alias{[<-,RasterLayer,ANY,missing-method}
-\alias{[<-,RasterLayer,missing,missing-method}
-\alias{[[,RasterLayer,ANY,ANY-method}
-\alias{[[<-,RasterLayer,ANY,ANY-method}
-
\title{ Replace methods }
\description{
@@ -18,21 +18,25 @@
\section{Methods}{
\describe{
+ if r is a RasterLayer, r[] is valid with a single index (cell number)
+ e.g.: r[1], r[6:15]
+ r[[]] is valid with two indices
+ e.g.: r[[1,1]], r[[1,]]
-
}}
\examples{
r <- raster(ncol=10, nrow=5)
r[] <- 1:ncell(r) * 2
r[1]
-r[,1]
-r[1,]
r[1:10]
r[3:8] <- NA
r[1:10]
+#r[[,1]]
+#r[[1,]]
+
}
\keyword{methods}
Modified: pkg/raster/man/distance.Rd
===================================================================
--- pkg/raster/man/distance.Rd 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/man/distance.Rd 2009-03-06 11:48:07 UTC (rev 317)
@@ -2,10 +2,13 @@
\docType{methods}
\alias{distance-methods}
\alias{distance}
+
\alias{distance,RasterLayer-method}
-\title{ Calculate distance from geographic features in a raster}
+
+\title{distance to raster cells}
+
\description{
- The function calculates the distance from the non-NA cells of the RasterLayer.
+ The function calculates the distance to cells of a RasterLayer that are not \code{NA}.
The distance is in meters if the RasterLayer is in a geographic (latlon) projection and in map units when not projected.
@@ -13,6 +16,7 @@
For more options (directions, cost-distance) see the gdistance package.
}
+
\section{Methods}{
\describe{
Modified: pkg/raster/man/get.Rd
===================================================================
--- pkg/raster/man/get.Rd 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/man/get.Rd 2009-03-06 11:48:07 UTC (rev 317)
@@ -1,89 +1,61 @@
-\name{get}
+\name{getRowColCell}
+
\alias{colFromCell}
\alias{rowFromCell}
\alias{cellFromRowCol}
-\alias{cellsFromRow}
-\alias{cellsFromCol}
-\alias{colFromX}
-\alias{rowFromY}
-\alias{cellFromXY}
-\alias{xFromCol}
-\alias{yFromRow}
-\alias{xyFromCell}
-\alias{cxyFromBbox}
-\alias{validCells}
-\alias{validCols}
-\alias{validRows}
+\alias{cellFromRowColCombine}
+\alias{cellFromRow}
+\alias{cellFromCol}
-\title{Get the column, row, or cell number of a raster from coordinates and vice versa}
+\title{Get row, column, or cell number}
\description{
-These functions get the column, row, or cell number of a Raster* object 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)
+These functions get the row or column number from a cell number of a Raster* object, or vice versa)
}
\usage{
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)
-xFromCol(object, colnr)
-yFromRow(object, rownr)
-xyFromCell(object, cell, asSpatialPoints=FALSE)
-cxyFromBbox(object, bbox)
-validCells(object, cell)
-validCols(object, colnr)
-validRows(object, rownr)
+cellFromRowColCombine(object, rownr, colnr)
+cellFromRow(object, rownr)
+cellFromCol(object, colnr)
}
\arguments{
\item{object}{Raster* object (or a SpatialPixels* or SpatialGrid* object)}
\item{cell}{cell number(s)}
- \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; 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}
}
\details{
The colFromCell and similar functions accept a single value (or x, y pair), or a vector or list of these values,
Cell numbers start at 1 in the upper left corner, and increase from left to right, and then from top to bottom
The last cell number equals the number of cells of the Raster* object.
+
+ In \code{cellFromRowCol}, \code{rownr} and \code{colnr} should have the same length.
+ This is not the case for \code{cellFromRowColCombine}. This function returns the cell numbers obtained by the combination of row and column numbers.
+
}
+
\value{
row, col or cell number(s)
- x or y coordinate(s)
- matrix(x,y) of pairs of coordinates
- matrix(cell, x, y) of cellnumbers and x and y coordinates
- TRUE of FALSE for valid*
}
\author{Robert J. Hijmans }
+
\examples{
#using a new default raster (1 degree global)
-rs <- raster()
-ncell(rs)
-colFromCell(rs, 10000)
-rowFromCell(rs, 10000)
-colFromX(rs, 0.5)
-rowFromY(rs, 0.5)
-cellFromXY(rs, c(0.5, 0.5))
-xFromCol(rs, c(1, 120, 180))
-yFromRow(rs, 90)
-xyFromCell(rs, 10000)
-xyFromCell(rs, c(0, 1, 32581, ncell(rs), ncell(rs)+1))
+r <- raster()
+colFromCell(r, 10000)
+rowFromCell(r, 10000)
+cellFromRowCol(r, 5, 5)
+cellFromRowCol(r, 4:5, 4:5)
+cellFromRowColCombine(r, 4:5, 4:5)
+cellFromCol(r, 1)
+cellFromRow(r, 1)
-#using a file from disk
-rs <- rasterFromFile(system.file("external/test.ag", package="sp"))
-rs
-cellFromXY(rs, c(180000, 330000))
-#xy for corners of grid:
-xyFromCell(rs, c(1, ncol(rs), nrow(rs), ncell(rs)))
}
+
\keyword{spatial}
Modified: pkg/raster/man/raster.Rd
===================================================================
--- pkg/raster/man/raster.Rd 2009-03-06 05:04:13 UTC (rev 316)
+++ pkg/raster/man/raster.Rd 2009-03-06 11:48:07 UTC (rev 317)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 317
More information about the Raster-commits
mailing list