[Raster-commits] r463 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 25 18:35:27 CEST 2009
Author: rhijmans
Date: 2009-05-25 18:35:26 +0200 (Mon, 25 May 2009)
New Revision: 463
Removed:
pkg/raster/man/coerce.Rd
Modified:
pkg/raster/DESCRIPTION
pkg/raster/NAMESPACE
pkg/raster/R/Artith.R
pkg/raster/R/Math.R
pkg/raster/R/coercion.R
pkg/raster/R/get.R
pkg/raster/R/hist.R
pkg/raster/R/linesToRaster.R
pkg/raster/R/map.R
pkg/raster/R/overlayStack.R
pkg/raster/R/polygonToRaster.R
pkg/raster/R/predict.R
pkg/raster/R/raster.R
pkg/raster/R/reclass.R
pkg/raster/R/stack.R
pkg/raster/R/stackAdd.R
pkg/raster/R/unstack.R
pkg/raster/R/validCell.R
pkg/raster/R/writeStack.R
pkg/raster/R/xyCell.R
pkg/raster/R/xyValues.R
pkg/raster/man/predict.Rd
pkg/raster/man/raster.Rd
pkg/raster/man/stack.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/DESCRIPTION 2009-05-25 16:35:26 UTC (rev 463)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.9-20
-Date: 19-May-2009
+Version: 0.8.9-21
+Date: 23-May-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>
Modified: pkg/raster/NAMESPACE
===================================================================
--- pkg/raster/NAMESPACE 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/NAMESPACE 2009-05-25 16:35:26 UTC (rev 463)
@@ -1,8 +1,8 @@
importFrom("methods", Ops, Math)
importFrom("graphics", hist, plot, lines, image, contour, persp)
-importFrom("stats", aggregate)
+importFrom("stats", aggregate, predict)
importFrom("utils", stack, unstack)
importFrom("sp", overlay, bbox, Spatial, SpatialPixels, SpatialPixelsDataFrame, SpatialGrid, SpatialGridDataFrame)
exportClasses(BoundingBox, BasicRaster, Raster, RasterLayer, RasterStack)
-exportMethods(raster, calc, overlay, bbox, aggregate, stack, unstack, show, summary, plot, hist, contour, persp, ncol, nrow, ncell, dim, Median)
+exportMethods(raster, calc, overlay, bbox, aggregate, predict, stack, unstack, show, summary, plot, hist, contour, persp, ncol, nrow, ncell, dim, Median)
exportPattern("^[^\\.]")
Modified: pkg/raster/R/Artith.R
===================================================================
--- pkg/raster/R/Artith.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/Artith.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -9,19 +9,20 @@
setMethod("Arith", signature(e1='RasterLayer', e2='RasterLayer'),
function(e1, e2){
if ( compare(c(e1, e2)) ) {
+ r <- raster(e1)
if (canProcessInMemory(e1, 4)) {
- raster <- raster(e1, values=callGeneric( as.numeric(.getRasterValues(e1)), .getRasterValues(e2)))
+ return( setValues(r, values=callGeneric( as.numeric(.getRasterValues(e1)), .getRasterValues(e2))) )
} else {
- raster <- raster(e1, filename=rasterTmpFile())
- for (r in 1:nrow(e1)) {
- raster <- setValues(raster, callGeneric( as.numeric(.getRowValues(e1, r)), .getRowValues(e2, r) ), r)
- raster <- writeRaster(raster)
+ filename(r) <- rasterTmpFile()
+ for (row in 1:nrow(e1)) {
+ r <- setValues(r, callGeneric( as.numeric(.getRowValues(e1, row)), .getRowValues(e2, row) ), row)
+ r <- writeRaster(r)
}
if (getOption('verbose')) {
cat('values were written to:', raster at file@name)
}
- }
- return(raster)
+ return(r)
+ }
}
}
)
@@ -29,36 +30,38 @@
setMethod("Arith", signature(e1='RasterLayer', e2='numeric'),
function(e1, e2){
+ r <- raster(e1)
if (canProcessInMemory(e1, 4)) {
- return(raster(e1, values=callGeneric(as.numeric(.getRasterValues(e1)), e2) ) )
+ return ( setValues(r, callGeneric(as.numeric(.getRasterValues(e1)), e2) ) )
} else {
- raster <- raster(e1, filename=rasterTmpFile())
- for (r in 1:nrow(e1)) {
- raster <- setValues(raster, callGeneric( as.numeric(.getRowValues(e1, r)), e2) , r)
- raster <- writeRaster(raster)
+ filename(r) <- rasterTmpFile()
+ for (row in 1:nrow(e1)) {
+ r <- setValues(r, callGeneric( as.numeric(.getRowValues(e1, row)), e2) , row)
+ r <- writeRaster(r)
}
if (getOption('verbose')) {
cat('values were written to:', filename(raster))
}
- return(raster)
+ return(r)
}
}
)
setMethod("Arith", signature(e1='numeric', e2='RasterLayer'),
function(e1, e2){
+ r <- raster(e2)
if (canProcessInMemory(e2, 4)) {
- return(raster(e2, values=callGeneric(as.numeric(e1), .getRasterValues(e2))))
+ return( setValues(r, callGeneric(as.numeric(e1), .getRasterValues(e2))) )
} else {
- raster <- raster(e2, filename=rasterTmpFile())
- for (r in 1:nrow(e2)) {
- raster <- setValues(raster, callGeneric(as.numeric(e1), .getRowValues(e2, r)) , r)
- raster <- writeRaster(raster)
+ filename(r) <- rasterTmpFile()
+ for (row in 1:nrow(e2)) {
+ r <- setValues(r, callGeneric(as.numeric(e1), .getRowValues(e2, row)) , row)
+ r <- writeRaster(r)
}
if (getOption('verbose')) {
cat('values were written to:', filename(raster))
}
- return(raster)
+ return(r)
}
}
)
Modified: pkg/raster/R/Math.R
===================================================================
--- pkg/raster/R/Math.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/Math.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -7,16 +7,15 @@
setMethod("Math", signature(x='RasterLayer'),
function(x){
-
fname <- as.character(sys.call(sys.parent())[[1]])
-
- if (canProcessInMemory(x, 3)) {
- rst <- raster(x, values=callGeneric(.getRasterValues(x)))
+ rst <- raster(x)
+ if (canProcessInMemory(rst, 3)) {
+ rst <- setValues(rst, callGeneric(.getRasterValues(x)))
if (fname %in% c('floor', 'ceiling', 'trunc')) {
dataType(rst) <- 'INT4S'
}
} else {
- rst <- raster(x, filename=rasterTmpFile())
+ filename(rst) <- rasterTmpFile()
if (fname %in% c('floor', 'ceiling', 'trunc')) {
dataType(rst) <- 'INT4S'
}
@@ -36,16 +35,17 @@
setMethod("Math2", signature(x='RasterLayer'),
function (x, digits=0) {
digits <- max(0, digits)
+ rst <- raster(x)
if (canProcessInMemory(x, 3)) {
- x <- setValues(x, callGeneric(values(x), digits))
+ rst <- setValues(rst, callGeneric( .getRasterValues(x), digits))
if (digits == 0) {
- dataType(x) <- 'INT4S'
+ dataType(rst) <- 'INT4S'
}
- return(x)
+ return(rst)
} else {
- rst <- raster(x, filename=rasterTmpFile())
+ filename(rst) <- rasterTmpFile()
if (digits == 0) {
- dataType(x) <- 'INT4S'
+ dataType(rst) <- 'INT4S'
}
for (r in 1:nrow(x)) {
rst <- setValues(rst, callGeneric(.getRowValues(x, r), digits), r)
Modified: pkg/raster/R/coercion.R
===================================================================
--- pkg/raster/R/coercion.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/coercion.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -63,134 +63,46 @@
setAs('RasterStack', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
+ function(from){ return( raster (from)) }
)
setAs('SpatialGridDataFrame', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
+ function(from){ return( raster (from)) }
)
setAs('SpatialPixelsDataFrame', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
+ function(from){ return(raster (from)) }
)
setAs('SpatialGrid', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
+ function(from){ return(raster (from)) }
)
setAs('SpatialPixels', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
+ function(from){ return(raster (from)) }
)
setAs('SpatialGrid', 'RasterStack',
- function(from){ return(.asRasterStack (from)) }
+ function(from){ return(stack(from)) }
)
setAs('SpatialGridDataFrame', 'RasterStack',
- function(from){ return(.asRasterStack (from)) }
+ function(from){ return(stack(from)) }
)
setAs('SpatialPixels', 'RasterStack',
- function(from){ return(.asRasterStack (from)) }
+ function(from){ return(stack(from)) }
)
setAs('SpatialPixelsDataFrame', 'RasterStack',
- function(from){ return(.asRasterStack (from)) }
+ function(from){ return(stack(from)) }
)
-if (!isGeneric("asRasterLayer")) {
- setGeneric("asRasterLayer", function(x, index)
- standardGeneric("asRasterLayer"))
-}
-
-setMethod('asRasterLayer', signature(x='RasterStack'),
- function(x, index){
- if (nlayers(x) > 0) {
- dindex <- max(1, min(nlayers(x), index))
- if (dindex != index) { warning(paste("index was changed to", dindex))}
- rs <- x at layers[[dindex]]
- if (dataContent(x) == 'all') {
- rs <- setValues(rs, values(x)[,dindex])
- }
- } else {
- rs <- new("RasterLayer")
- rs <- setExtent(rs, extent(x))
- rowcol(rs) <- c(nrow(x), ncol(x))
- }
- return(rs)
- }
-)
-
-
-
-setMethod('asRasterLayer', signature(x='SpatialPixelsDataFrame'),
- function(x, index){
- r <- raster()
- r <- setExtent(r, extent(x))
- projection(r) <- x at proj4string
- rowcol(r) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
- dindex <- max(1, min(dim(x at data)[2], index))
- if (dindex != index) { warning(paste("index was changed to", dindex))}
-# to become an option, but currently support for sparse is too ..... sparse
- sparse <- FALSE
- if (!sparse) {
- x <- as(x, 'SpatialGridDataFrame')
- r <- setValues(r, x at data[[dindex]])
- } else {
- cells <- x at grid.index
- if (length(cells)==0) {
- cells <- cellFromXY(r, x at coords)
- }
- r <- setValuesSparse(r, cells, x at data[[dindex]])
- }
- return(r)
- }
-)
-
-
-
-setMethod('asRasterLayer', signature(x='SpatialGridDataFrame'),
- function(x, index){
- r <- raster()
- r <- setExtent(r, extent(x))
- projection(r) <- x at proj4string
- rowcol(r) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
- dindex <- max(1, min(dim(x at data)[2], index))
- if (dindex != index) { warning(paste("index was changed to", dindex))}
- r <- setValues(r, x at data[[dindex]])
- return(r)
- }
-)
-
-
-
-
-.asRasterStack <- function(spgrid) {
- stk <- new("RasterStack")
- stk <- setExtent(stk, extent(spgrid))
- projection(stk) <- spgrid at proj4string
- rowcol(stk) <- c(spgrid at grid@cells.dim[2], spgrid at grid@cells.dim[1])
-
- if (class(spgrid)=='SpatialPixelsDataFrame') {
- spgrid <- as(spgrid, 'SpatialGridDataFrame')
- }
- if (class(spgrid)=='SpatialGridDataFrame' ) {
- stk <- setValues(stk, as.matrix(spgrid at data))
- rs <- as(stk, 'RasterLayer')
- stk <- setValues(stk, as.matrix(spgrid at data))
- for (i in 1:ncol(spgrid at data)) {
- stk at layers[i] <- rs
- }
- }
- return(stk)
-}
-
-
.toSpBbox <- function(object) {
b <- extent(object)
bb <- matrix(NA, 2, 2)
Modified: pkg/raster/R/get.R
===================================================================
--- pkg/raster/R/get.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/get.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -14,7 +14,7 @@
}
rowFromCell <- function(object, cell) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
cell <- round(cell)
cell[cell < 1 | cell > ncell(object)] <- NA
rownr <- as.integer(trunc((cell-1)/ncol(object)) + 1)
@@ -23,14 +23,14 @@
cellFromRow <- function(object, rownr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
cols <- rep(1:ncol(object), times=length(rownr))
rows <- rep(rownr, each=length(cols))
return(cellFromRowCol(object, rows, cols))
}
cellFromCol <- function(object, colnr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
rows <- rep(1:nrow(object), times=length(colnr))
cols <- rep(colnr, each=nrow(object))
return(cellFromRowCol(object, rows, cols))
@@ -43,7 +43,7 @@
}
colFromCell <- function(object, cell) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
cell <- round(cell)
cell[cell < 1 | cell > ncell(object)] <- NA
rownr <- as.integer(trunc((cell-1)/ncol(object)) + 1)
@@ -52,7 +52,7 @@
}
cellFromRowCol <- function(object, rownr, colnr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
rownr <- round(rownr)
colnr <- round(colnr)
rownr[rownr < 1 | rownr > nrow(object)] <- NA
Modified: pkg/raster/R/hist.R
===================================================================
--- pkg/raster/R/hist.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/hist.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -6,7 +6,7 @@
setMethod('hist', signature(x='RasterStack'),
function(x, layer=1, maxsamp=100000, ...) {
- x <- asRasterLayer(x, layer)
+ x <- raster(x, layer)
hist(x, maxsamp=100000, ...)
}
)
Modified: pkg/raster/R/linesToRaster.R
===================================================================
--- pkg/raster/R/linesToRaster.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/linesToRaster.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -96,7 +96,8 @@
stop('updateValue should be either "all", "NA", "!NA", or "zero"')
}
}
- raster <- raster(raster, filename)
+ raster <- raster(raster)
+ filename(raster) <- filename
dataType(raster) <- datatype
Modified: pkg/raster/R/map.R
===================================================================
--- pkg/raster/R/map.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/map.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -16,7 +16,7 @@
index <- round(index)
i <- min(max(1, index), nlayers(object))
if (i != index) { stop("index should be >= 1 and <=", nlayers(object), " =nlayers(object)") }
- raster2 <- asRasterLayer(object, i)
+ raster2 <- raster(object, i)
if (dataContent(object) == 'all') {
raster2 <- setValues(raster2, values(object)[,i])
}
Modified: pkg/raster/R/overlayStack.R
===================================================================
--- pkg/raster/R/overlayStack.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/overlayStack.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -15,7 +15,7 @@
rasters <- list()
for (i in 1:length(indices)) {
- rasters[i] <- asRasterLayer(x, indices[i])
+ rasters[i] <- raster(x, indices[i])
}
if (missing(fun)) {
Modified: pkg/raster/R/polygonToRaster.R
===================================================================
--- pkg/raster/R/polygonToRaster.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/polygonToRaster.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -74,7 +74,8 @@
stop('updateValue should be either "all", "NA", "!NA", or "zero"')
}
}
- raster <- raster(raster, filename)
+ raster <- raster(raster)
+ filename(raster) <- filename
dataType(raster) <- datatype
starttime <- proc.time()
Modified: pkg/raster/R/predict.R
===================================================================
--- pkg/raster/R/predict.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/predict.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -5,24 +5,37 @@
}
setMethod('predict', signature(object='RasterStack'),
- function(object, model, filename="", datatype='INT4S', filetype = 'raster', overwrite=FALSE, track=-1, ...) {
+ function(object, model, filename="", datatype='FLT4S', filetype = 'raster', overwrite=FALSE, track=-1, ...) {
predrast <- raster(object)
filename(predrast) <- filename
dataType(predrast) <- datatype
- myIdVar <- 1:ncol(object)
- predv <- 1:ncol(object)
- for (r in 1:nrow(object)) {
- object <- readRow(object, r)
- rowvals <- na.omit( cbind(myIdVar, values(object, names=TRUE)) )
- indices <- rowvals[,1]
+
+ if (dataContent(object) == 'all') {
+ indices <- 1:ncell(predrast)
+ rowvals <- data.frame( na.omit(cbind( indices, values(object, names=TRUE)) ) )
+ predv <- indices
predv[] <- NA
- if (length(indices) > 0) {
- pred <- predict(model, rowvals[,-1], ...)
- predv[indices] <- pred
+ predv[indices] <- predict(model, rowvals[,-1], ...)
+ predrast <- setValues(predrast, predv)
+ if (filename(predrast) != "") {
+ predrast <- writeRaster(predrast)
}
- predrast <- setValues(predrast, predv, r)
- predrast <- writeRaster(predrast, filetype=filetype, overwrite=overwrite)
- }
+ return(predrast)
+ } else {
+ myIdVar <- 1:ncol(object)
+ predv <- 1:ncol(object)
+ for (r in 1:nrow(object)) {
+ object <- readRow(object, r)
+ rowvals <- na.omit( cbind(myIdVar, values(object, names=TRUE)) )
+ indices <- rowvals[,1]
+ predv[] <- NA
+ if (length(indices) > 0) {
+ predv[indices] <- predict(model, data.frame(rowvals[,-1]), ...)
+ }
+ predrast <- setValues(predrast, predv, r)
+ predrast <- writeRaster(predrast, filetype=filetype, overwrite=overwrite)
+ }
+ }
return(predrast)
}
)
Modified: pkg/raster/R/raster.R
===================================================================
--- pkg/raster/R/raster.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/raster.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -47,28 +47,38 @@
setMethod('raster', signature(x='Raster'),
- function(x, filename="", values=NULL) {
-
- if (class(x) == 'RasterStack') {
- x <- asRasterLayer(x, 1)
- }
-
+ function(x, filename="", datatype="FLT4S", values=NULL) {
r <- raster(xmn=xmin(x), xmx=xmax(x), ymn=ymin(x), ymx=ymax(x), nrows=nrow(x), ncols=ncol(x), projs=projection(x))
filename(r) <- filename
-
- if (r at file@name != "" & r at file@name == x at file@name) {
- stop("it is not allowed to set the filename of the output RasterLayer to that of the input RasterLayer")
- }
-
if (!is.null(values)) {
- r <- setValues(r, values)
+ x <- setValues(x, values)
}
return(r)
}
)
+setMethod('raster', signature(x='RasterStack'),
+ function(x, index=1){
+ if (nlayers(x) > 0 & index > 0) {
+ dindex <- max(1, min(nlayers(x), index))
+ if (dindex != index) { warning(paste("index was changed to", dindex))}
+ r <- x at layers[[dindex]]
+ if (dataContent(x) == 'all') {
+ r <- setValues(r, values(x)[,dindex])
+ }
+ } else {
+ r <- new("RasterLayer")
+ extent(r) <- extent(x)
+ rowcol(r) <- c(nrow(x), ncol(x))
+ }
+ return(r)
+ }
+)
+
+
+
setMethod('raster', signature(x='BoundingBox'),
function(x, nrows=10, ncols=10, projs=NA) {
bb <- extent(x)
@@ -82,3 +92,38 @@
}
)
+
+setMethod('raster', signature(x='SpatialGrid'),
+ function(x, index=0){
+ r <- raster()
+ r <- setExtent(r, extent(x))
+ projection(r) <- x at proj4string
+ rowcol(r) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
+ if (index > 0 & class(x) == 'SpatialGridDataFrame') {
+ dindex <- max(1, min(dim(x at data)[2], index))
+ if (dindex != index) { warning(paste("index was changed to", dindex))}
+ r <- setValues(r, x at data[[dindex]])
+ }
+ return(r)
+ }
+)
+
+
+setMethod('raster', signature(x='SpatialPixels'),
+ function(x, index=0){
+ r <- raster()
+ r <- setExtent(r, extent(x))
+ projection(r) <- x at proj4string
+ rowcol(r) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
+ if (index > 0 & class(x) == 'SpatialPixelsDataFrame') {
+ dindex <- max(1, min(dim(x at data)[2], index))
+ if (dindex != index) { warning(paste("index was changed to", dindex))}
+ x <- as(x, 'SpatialGridDataFrame')
+ r <- setValues(r, x at data[[dindex]])
+ }
+ return(r)
+ }
+)
+
+
+
Modified: pkg/raster/R/reclass.R
===================================================================
--- pkg/raster/R/reclass.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/reclass.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -23,19 +23,20 @@
print(rclmat)
}
- if (dataContent(raster) == 'all') { nr <- 1 } else { nr <- 2 }
- if (!canProcessInMemory(raster, nr) && filename == '') {
+ if (!canProcessInMemory(raster, 2) && filename == '') {
filename <- rasterTmpFile()
if (getOption('verbose')) { cat('writing raster to:', filename(outRaster)) }
}
- outRaster <- raster(raster)
- filename(outRaster) <- filename
- dataType(outRaster) <- datatype
+ outRaster <- raster(raster, filename=filename, datatype=datatype)
res <- vector(length = ncol(raster))
- if ( dataContent(raster) == 'all' | dataContent(raster) == 'sparse') {
+
+ if ( filename == "" ) {
+ if (dataContent( raster ) != 'all') {
+ raster <- readAll(raster)
+ }
res <- values(raster)
if (update) {
for (i in 1:length(rclmat[,1])) {
@@ -54,16 +55,9 @@
}
}
}
- if ( dataContent(raster) == 'all') {
- outRaster <- setValues(outRaster, res)
- }
- if ( dataContent(raster) == 'sparse') {
- outRaster <- setValues(outRaster, res, dataIndices(raster))
- }
- if (outRaster at file@name != "" ) {
- outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype)
- }
+ return( setValues(outRaster, res) )
+
} else {
starttime <- proc.time()
hasNA <- FALSE
@@ -105,7 +99,7 @@
}
if (r %in% track) { .showTrack(r, outRaster at nrows, track, starttime) }
}
- }
- return(outRaster)
+ return(outRaster)
+ }
}
Modified: pkg/raster/R/stack.R
===================================================================
--- pkg/raster/R/stack.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/stack.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -19,6 +19,12 @@
standardGeneric("stack"))
}
+setMethod("stack", signature(x='missing'),
+function(x) {
+ return(new("RasterStack"))
+ }
+)
+
setMethod("stack", signature(x='Raster'),
function(x, ..., bands=NULL) {
rlist <- c(x, list(...))
@@ -43,15 +49,15 @@
if (is.character(x[[i]])) {
if (is.null(bands)) {
r[j] <- raster(x[[i]])
+ } else if (bands[[i]] > 0) {
+ r[j] <- raster(x[[i]], bands[[i]])
} else {
- if (bands[[i]] < 1) {
- r[j] <- raster(x[[i]], 1)
- bds <- nbands(r)
- if (bds > 1) {
- for (b in 2:bds) {
- j <- j + 1
- r[j] <- raster(x[[i]], b)
- }
+ r[j] <- raster(x[[i]], 1)
+ bds <- nbands(r[[j]])
+ if (bds > 1) {
+ for (b in 2:bds) {
+ j <- j + 1
+ r[j] <- raster(x[[i]], band=b)
}
}
}
@@ -65,3 +71,29 @@
} )
+setMethod("stack", signature(x='SpatialGrid'),
+ function(x) {
+ stk <- new("RasterStack")
+ stk <- setExtent(stk, extent(x))
+ projection(stk) <- x at proj4string
+ rowcol(stk) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
+
+ if (class(x)=='SpatialGridDataFrame') {
+ stk <- setValues(stk, as.matrix(x at data))
+ rs <- as(stk, 'RasterLayer')
+ stk <- setValues(stk, as.matrix(x at data))
+ for (i in 1:ncol(x at data)) {
+ stk at layers[i] <- rs
+ }
+ }
+ return(stk)
+ }
+)
+
+
+setMethod("stack", signature(x='SpatialPixels'),
+ function(x) {
+ x <- as(x, 'SpatialGridDataFrame')
+ return(stack(x))
+ }
+)
\ No newline at end of file
Modified: pkg/raster/R/stackAdd.R
===================================================================
--- pkg/raster/R/stackAdd.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/stackAdd.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -55,7 +55,7 @@
rstack <- setExtent(rstack, raster, snap=FALSE)
projection(rstack) <- projection(raster)
- nl <- rstack at data@nlayers + nlayers(raster)
+ nl <- 1
rstack at data@nlayers <- as.integer(nl)
rstack at layers[nl] <- raster
rstack at data@min[nl] <- raster at data@min
@@ -88,7 +88,7 @@
}
for (k in 1:length(rasterlist)) {
- nl <- as.integer( rstack at data@nlayers + nlayers(raster) )
+ nl <- as.integer( rstack at data@nlayers + 1 )
rstack at data@nlayers <- nl
rstack at layers[nl] <- raster
rstack at data@min[nl] <- raster at data@min
@@ -129,4 +129,3 @@
return(rstack)
}
-
Modified: pkg/raster/R/unstack.R
===================================================================
--- pkg/raster/R/unstack.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/unstack.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -14,7 +14,7 @@
function(x) {
rlist <- list()
for (i in nlayers(x):1) {
- rlist[i] <- asRasterLayer(x, i)
+ rlist[i] <- raster(x, i)
x <- dropLayer(x, i)
}
return(rlist)
Modified: pkg/raster/R/validCell.R
===================================================================
--- pkg/raster/R/validCell.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/validCell.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -6,7 +6,7 @@
validCell <- function(object, cell) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
cell <- round(cell)
validcell <- vector(length=length(cell))
validcell[cell > 0 & cell <= ncell(object)] <- TRUE
@@ -14,7 +14,7 @@
}
validRow <- function(object, rownr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
rownr <- round(rownr)
validrows <- vector(length=length(rownr))
validrows[rownr > 0 & rownr <= nrow(object)] <- TRUE
@@ -22,7 +22,7 @@
}
validCol <- function(object, colnr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
colnr <- round(colnr)
validcols <- vector(length=length(colnr))
validcols[colnr > 0 & colnr <= nrow(object)] <- TRUE
Modified: pkg/raster/R/writeStack.R
===================================================================
--- pkg/raster/R/writeStack.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/writeStack.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -55,7 +55,7 @@
} else {
fakerow <- 0
for (i in 1:nl) {
- sr <- asRasterLayer(rstack, i)
+ sr <- raster(rstack, i)
for (r in 1:nrow(sr)) {
fakerow <- fakerow + 1
sr <- readRow(sr, r)
Modified: pkg/raster/R/xyCell.R
===================================================================
--- pkg/raster/R/xyCell.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/xyCell.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -6,7 +6,7 @@
yFromRow <- function(object, rownr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
rownr <- round(rownr)
rownr[rownr < 1 | rownr > nrow(object)] <- NA
y <- ymax(object) - ((rownr-0.5) * yres(object))
@@ -15,7 +15,7 @@
xFromCol <- function(object, colnr) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
colnr <- round(colnr)
colnr[colnr < 1 | colnr > ncol(object)] <- NA
x <- xmin(object) + (colnr - 0.5) * xres(object)
@@ -23,7 +23,7 @@
cellFromXY <- function(object, xy) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
if (class(xy) == 'SpatialPoints' | class(xy) == 'SpatialPointsDataFrame') {
x <- coordinates(xy)[,1]
y <- coordinates(xy)[,2]
@@ -42,7 +42,7 @@
colFromX <- function ( object, x ) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
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)
@@ -52,7 +52,7 @@
rowFromY <- function ( object, y ) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
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)
@@ -62,7 +62,7 @@
xyFromCell <- function(object, cell, asSpatialPoints=FALSE) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
cell <- round(cell)
xy <- matrix(data = NA, ncol=2, nrow=length(cell))
colnr <- colFromCell(object, cell)
@@ -79,7 +79,7 @@
cxyFromBbox <- function(object, bbox) {
- if (.isSPgrid(object)) { object <- asRasterLayer(object, FALSE) }
+ if (.isSPgrid(object)) { object <- raster(object) }
bbox <- extent(bbox)
cells <- cellsFromBbox(object, bbox)
cxy <- cbind(cells, xyFromCell(object, cells))
Modified: pkg/raster/R/xyValues.R
===================================================================
--- pkg/raster/R/xyValues.R 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/R/xyValues.R 2009-05-25 16:35:26 UTC (rev 463)
@@ -62,7 +62,7 @@
if (method == 'bilinear') {
for (i in seq(nlayers(object))) {
- r <- asRasterLayer(object, i)
+ r <- raster(object, i)
v <- .bilinearValue(r, xyCoords)
if (i == 1) {
result <- v
Deleted: pkg/raster/man/coerce.Rd
===================================================================
--- pkg/raster/man/coerce.Rd 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/man/coerce.Rd 2009-05-25 16:35:26 UTC (rev 463)
@@ -1,61 +0,0 @@
-\name{Coercion}
-
-\alias{asRasterLayer,RasterStack-method}
-\alias{asRasterLayer,SpatialPixelsDataFrame-method}
-\alias{asRasterLayer,SpatialGridDataFrame-method}
-\alias{asRasterLayer}
-
-\title{Coercion}
-
-\description{
-Functions to coerce a SpatialGridDataFrame, SpatialPixelsDataFrame, and RasterStack objects to a RasterLayer object.
-You can use
-
-\code{as( , )}
-
-for this type of coercion (see examples), and other coercions between sp and raster objects,
-but \code{asRasterLayer} allows for indicating which variable should be passed to the \code{RasterLayer} object.
-While \code{RasterLayer} objects only have a single variable, a \code{RasterStack} and the \code{Spatial * DataFrame}
- objects can have multiple variables.
-}
-
-\usage{
-asRasterLayer(x, index)
-}
-
-\arguments{
- \item{x}{ a Raster* type object (SpatialPixel, SpatialPixelDataFrame , SpatialGrid, or SpatialGridDataFrame }
- \item{index}{integer (between 1 and \code{nlayers(x)} indicating the layer in the RasterStack, or the column in the sp object dataframe to take the values from}
-}
-
-\details{
- if \code{type} is 'pixel' a SpatialPixel* object is returned. If the RasterLayer object has data a SpatialPixelDataFrame will be returned.
- if \code{type} is 'grid' a SpatialGrid* object is returned. If the RasterLayer object has data a SpatialGridDataFrame will be returned.
-
- In most cases you can also coerce objects using \code{as}, except that you cannot change the default 'index' (variable) and the first variable (column of the data frame of a Spatial* object) is used.
-
- e.g.: \code{as(aSpatialPixelsDataFrame, "RasterStack")} or \code{as(aRasterLayer, "SpatialGridDataFrame")}
-}
-
-\value{
-a RasterLayer object
-}
-\author{ Robert J. Hijmans}
-
-\seealso{ \code{\link[raster]{RasterLayer-class}}, \code{\link[sp]{SpatialGridDataFrame-class}}, \code{\link[methods]{as}}}
-
-\examples{
-r1 <- raster(ncols=90, nrows=45)
-r1 <- setValues(r1, 1:ncell(r1))
-r2 <- setValues(r1, 1:ncell(r1))
-stk <- stack(r1, r2)
-sp <- as(stk, 'SpatialGridDataFrame')
-r3 <- asRasterLayer(sp, 2)
-as(r2, 'BasicRaster') == as(r3, 'BasicRaster')
-all(values(r2) == values(r3))
-r4 <- asRasterLayer(stk, 1)
-sp <- as(r4, 'SpatialPixels')
-sp <- as(r4, 'SpatialGridDataFrame')
-}
-
-\keyword{ spatial }
Modified: pkg/raster/man/predict.Rd
===================================================================
--- pkg/raster/man/predict.Rd 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/man/predict.Rd 2009-05-25 16:35:26 UTC (rev 463)
@@ -8,7 +8,7 @@
\title{Predict}
\description{
- Predict values for a fitted model object and a RasterStack as independent variables
+Make a RasterLayer with a prediction based on a a fitted model object and a RasterStack object as independent variables. The RasterStack should have been used (via xyValues) to obtain the values that were used to fit the model. Any type of model (e.g. glm) for which a predict method has been implemented can be used.
}
\usage{
@@ -48,6 +48,41 @@
\author{ Robert J. Hijmans}
\examples{
+# A simple model to predict the location of the R in the R-logo using 20 presence points
+# and 50 (random) pseudo-absence points. This type of model is often used to predict species distributions
+
+# create a RasterStack (i.e. a pointer to a set of predictor rasters)
+logo <- stack(system.file("pictures/Rlogo.jpg", package="rgdal"), bands=-1)
+r <- sqrt(raster(logo,1) * raster(logo,2))
+logo <- addLayer(logo, r)
+layerNames(logo) <- c('band1', 'band2', 'band3', 'interaction')
+
+#get presence and absence points
+presence <- matrix(c(48.243420, 48.243420, 47.985820, 52.880230, 49.531423, 46.182616, 54.168232, 69.624263, 83.792291, 85.337894, 74.261072, 83.792291, 95.126713, 84.565092, 66.275456, 41.803408, 25.832176, 3.936132, 18.876962, 17.331359,7.048974, 13.648543, 26.093446, 28.544714, 39.104026, 44.572240, 51.171810, 56.262906, 46.269272, 38.161230, 30.618865, 21.945145, 34.390047, 59.656971, 69.839163, 73.233228, 63.239594, 45.892154, 43.252326, 28.356155), ncol=2)
+# random absence
+absence <- cbind(runif(50)*(xmax(logo)-xmin(logo))+xmin(logo), runif(50)*(ymax(logo)-ymin(logo))+ymin(logo))
+
+#par(mfrow=c(1,2))
+#plot(r)
+#points(presence)
+#points(absence, col='red')
+
+#extract values from stack
+xy <- rbind(cbind(1, presence), cbind(0, absence))
+v <- cbind(xy[,1], xyValues(logo, xy[,2:3]))
+colnames(v)[1] <- 'presabs'
+
+#build model
+formula <- paste(colnames(v)[1], '~', paste(colnames(v)[2:ncol(v)], collapse=" + "))
+model <- glm(formula, data=data.frame(v))
+
+#predict to a raster
+r <- predict(logo, model)
+
+#plot(r>0.3)
+#points(presence)
+#points(absence, col='red')
+
}
\keyword{methods}
Modified: pkg/raster/man/raster.Rd
===================================================================
--- pkg/raster/man/raster.Rd 2009-05-20 12:29:54 UTC (rev 462)
+++ pkg/raster/man/raster.Rd 2009-05-25 16:35:26 UTC (rev 463)
@@ -7,18 +7,21 @@
\alias{raster,character-method}
\alias{raster,missing-method}
\alias{raster,Raster-method}
+\alias{raster,RasterStack-method}
+\alias{raster,SpatialGrid-method}
+\alias{raster,SpatialPixels-method}
\alias{raster,matrix-method}
\title{Create a RasterLayer object}
\description{
- Create a new RasterLayer object from a filename, from scratch, a BoundingBox, or a Raster* object.
- The created object does normally not contain any cell (pixel) values, it only has the parameters that describe the RasterLayer.
+Methods to create a RasterLayer object. RasterLayer objects can be created from a filename, from scratch, a BoundingBox, or a Raster* or SpatialPixels* or SpatialGrid* object.
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 463
More information about the Raster-commits
mailing list