[Raster-commits] r147 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jan 17 09:15:19 CET 2009
Author: rhijmans
Date: 2009-01-17 09:15:19 +0100 (Sat, 17 Jan 2009)
New Revision: 147
Added:
pkg/raster/man/cover.Rd
Modified:
pkg/raster/R/Overlay.R
pkg/raster/R/replacement.R
pkg/raster/man/overlay.Rd
Log:
Modified: pkg/raster/R/Overlay.R
===================================================================
--- pkg/raster/R/Overlay.R 2009-01-17 02:28:33 UTC (rev 146)
+++ pkg/raster/R/Overlay.R 2009-01-17 08:15:19 UTC (rev 147)
@@ -5,35 +5,73 @@
# Licence GPL v3
-
-setMethod('overlay', signature(x='RasterLayer', y='RasterLayer'),
- function(x, y, fun=function(x,y){return(x+y)}, filename="", overwrite=FALSE, ...){
- return(.Overlay(x, y, fun, filename, overwrite) )
+Overlay <- function(raster1, raster2, ..., fun=function(x,y){return(x+y)}, filename="", overwrite=FALSE) {
+# if (class(raster1) != 'RasterLayer' | class(raster2) != 'RasterLayer') {
+# stop('first two arguments should be objects of class "RasterLayer"')}
+ rasters <- c(raster1, raster2)
+ obs <- list(...)
+ if (isTRUE(length(obs) > 0)) {
+ for (i in 1:length(obs)) {
+ if (extends(class(obs[[i]]), "RasterLayer")) {
+ rasters <- c(rasters, obs[[i]])
+ }
+ }
}
-)
-
-
-.Overlay <- function(raster1, raster2, fun=function(x,y){return(x+y)}, filename="", overwrite=FALSE) {
- if (class(raster1) != 'RasterLayer' | class(raster2) != 'RasterLayer') {
- stop('first two arguments should be objects of class "RasterLayer"')
+ if (length(rasters) > 6) {stop("sorry, this function cannot take more than 5 RasterLayers at a time")}
+
+ for (i in 2:length(rasters)) {
+ if (!compare(c(raster1, rasters[i]))) {
+ stop('Extent and/or resolution of rasters do not match')
+ }
}
- if (!compare(c(raster1, raster2))) {
- stop('Extent and/or resolution of rasters do not match')
- }
outraster <- setRaster(raster1)
outraster <- setFilename(outraster, filename)
- if ( dataContent(raster1) == 'all' & dataContent(raster2) == 'all') {
- vals <- fun( values(raster1), values(raster2) )
+ inram <- TRUE
+ ondisk <- TRUE
+ for (i in 1:length(rasters)) {
+ if (dataContent(rasters[[i]]) != 'all') {inram <- FALSE}
+ if (dataSource(rasters[[i]]) != 'disk') {ondisk <- FALSE}
+ }
+
+
+ if ( inram ) {
+ # there has to be a smarter way then this!
+ if (length(rasters) == 2) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]) )
+ } else if (length(rasters) == 3) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]) )
+ } else if (length(rasters) == 4) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]), values(rasters[[4]]) )
+ } else if (length(rasters) == 5) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]), values(rasters[[4]]), values(rasters[[5]]) )
+ } else if (length(rasters) == 6) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]), values(rasters[[4]]), values(rasters[[5]]), values(rasters[[6]]) )
+ }
+
outraster <- setValues(outraster, vals)
if (filename(outraster) != "") { writeRaster(outraster, overwrite=overwrite) }
-
- } else if ( dataSource(raster1) == 'disk' & dataSource(raster2) == 'disk') {
+ } else if ( ondisk ) {
v <- vector(length=0)
for (r in 1:nrow(outraster)) {
- raster1 <- readRow(raster1, r)
- raster2 <- readRow(raster2, r)
- vals <- fun(values(raster1), values(raster2))
+ for (i in 1:length(rasters)) {
+ if (dataSource(rasters[[i]]) == 'ram') {
+ rasters[i] <- valuesRow(rasters[[i]], r)
+ } else {
+ rasters[i] <- readRow(rasters[[i]], r)
+ }
+ }
+ if (length(rasters) == 2) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]) )
+ } else if (length(rasters) == 3) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]) )
+ } else if (length(rasters) == 4) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]), values(rasters[[4]]) )
+ } else if (length(rasters) == 5) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]), values(rasters[[4]]), values(rasters[[5]]) )
+ } else if (length(rasters) == 6) {
+ vals <- fun( values(rasters[[1]]), values(rasters[[2]]), values(rasters[[3]]), values(rasters[[4]]), values(rasters[[5]]), values(rasters[[6]]) )
+ }
if (filename(outraster) == "") {
v <- c(v, vals)
} else {
@@ -44,9 +82,7 @@
if (filename(outraster) == "") {
outraster <- setValues(outraster, v)
}
- } else {
- stop('values of rasters must be either all in memory or all on disk')
- }
+ }
return(outraster)
}
Modified: pkg/raster/R/replacement.R
===================================================================
--- pkg/raster/R/replacement.R 2009-01-17 02:28:33 UTC (rev 146)
+++ pkg/raster/R/replacement.R 2009-01-17 08:15:19 UTC (rev 147)
@@ -45,15 +45,16 @@
function(x, i, j, value) {
if (!missing(j)) { stop("incorrect number of dimensions") }
# what about data rows ?
- if (dataContent(x) != 'nodata') {
+ if (dataContent(x) == 'nodata') {
if (ncell(x) < 1000000) {
if (dataSource(x) == 'disk') {
x <- readAll(x)
} else {
- stop('no data associated with this RasterLayer object')
+ x <- setValues(x, vector(length=ncell(x)), v)
+ x at data@values[] <- NA
}
} else {
- stop('Large raster, no data in memory, use readAll() first')
+ stop('Large raster with no data in memory, use readAll() first')
}
}
x at data@values[i] <- value
Added: pkg/raster/man/cover.Rd
===================================================================
--- pkg/raster/man/cover.Rd (rev 0)
+++ pkg/raster/man/cover.Rd 2009-01-17 08:15:19 UTC (rev 147)
@@ -0,0 +1,36 @@
+\name{cover}
+\alias{cover}
+
+\title{ Raster cover calculation }
+\description{
+ Replace NA values in a raster with the values of another raster
+}
+
+\usage{
+ cover(raster1, raster2, filename="", overwrite=TRUE)
+}
+
+\arguments{
+ \item{raster1}{ a RasterLayer object }
+ \item{raster2}{ a RasterLayer object }
+ \item{filename}{ filename for the output raster. A valid filename must be provided when the data of the input rasters are on disk }
+ \item{overwrite}{logical. If \code{TRUE}, existing files will be overwritten}
+}
+
+\details{
+ the function returns a RasterLayer with the values of the second RasterLayer where the first RasterLayer values are NA; and the values of the first RasterLayer elsewhere.
+}
+\value{
+ a new RasterLayer object (if a filename is provided, a file on disk)
+}
+\author{ Robert J. Hijmans \email{r.hijmans at gmail.com} }
+
+\examples{
+ r <- newRaster()
+ r1 <- init(r)
+ r2 <- init(r)
+ r3 <- setNA(r2, value=0.5)
+ r4 <- cover(r3, r1)
+}
+
+\keyword{ spatial }
Modified: pkg/raster/man/overlay.Rd
===================================================================
--- pkg/raster/man/overlay.Rd 2009-01-17 02:28:33 UTC (rev 146)
+++ pkg/raster/man/overlay.Rd 2009-01-17 08:15:19 UTC (rev 147)
@@ -1,23 +1,20 @@
\name{overlay}
-\alias{overlay,RasterLayer,RasterLayer-method}
-\alias{overlay}
-\alias{cover}
+\alias{Overlay}
\title{ Raster overlay calculation }
\description{
Calculate values for a new RasterLayer object, based on two other rasters.
- overlay(raster1, raster2, fun=function(x,y){return(x+y)}, filename="", overwrite=FALSE)
- \item{fun}{ the function to be appliepd. This should be a function that takes two numbers as an argument }
-
}
\usage{
- cover(raster1, raster2, filename="", overwrite=TRUE)
+ Overlay(raster1, raster2, ..., fun=function(x,y){return(x+y)}, filename="", overwrite=FALSE)
}
\arguments{
\item{raster1}{ a RasterLayer object }
\item{raster2}{ a RasterLayer object }
+ \item{...}{ additional RasterLayer objects (up to 3) }
+ \item{fun}{ the function to be appliepd. This should be a function that takes two numbers as an argument }
\item{filename}{ filename for the output raster. A valid filename must be provided when the data of the input rasters are on disk }
\item{overwrite}{logical. If \code{TRUE}, existing files will be overwritten}
}
@@ -29,7 +26,6 @@
some overlay functions have been implemented as generic functions (*, /, +, -)
- the \code{cover} function returns the values of the first raster, except where the first raster values are NA
}
\value{
a new RasterLayer object (if a filename is provided, a file on disk)
@@ -40,18 +36,12 @@
r <- newRaster()
r1 <- init(r)
r2 <- init(r)
- r3 <- overlay(r1, r2)
- r4 <- setNA(r3, value=1)
- r5 <- cover(r4, r1)
-# hist(r1)
-# hist(r3)
-# hist(r4)
-# hist(r5)
+ r3 <- Overlay(r1, r2)
-# long version
- r6 <- overlay(r1, r2, fun=function(x,y){return(x*y)} )
-# short 'generic' function
- r7 <- r1 * r2
+# long version for multiplication
+ r4 <- Overlay(r1, r2, fun=function(x,y){return(x*y)} )
+# short function doing the same, if values can be loaded into ram memory
+ r5 <- r1 * r2
}
\keyword{ spatial }
More information about the Raster-commits
mailing list