[Raster-commits] r209 - pkg/raster/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 29 09:48:46 CET 2009
Author: rhijmans
Date: 2009-01-29 09:48:45 +0100 (Thu, 29 Jan 2009)
New Revision: 209
Modified:
pkg/raster/R/Overlay.R
pkg/raster/R/conversion.R
pkg/raster/R/polygonToRaster.R
pkg/raster/R/values.R
Log:
Modified: pkg/raster/R/Overlay.R
===================================================================
--- pkg/raster/R/Overlay.R 2009-01-29 06:32:28 UTC (rev 208)
+++ pkg/raster/R/Overlay.R 2009-01-29 08:48:45 UTC (rev 209)
@@ -28,7 +28,6 @@
}
}
}
- if (length(rasters) > 6) {stop("sorry, this function cannot take more than 6 RasterLayers at a time")}
f <- formals(fun)
if (length(f) != length(rasters)) {
@@ -46,28 +45,19 @@
if (asInt) { outraster <- setDatatype(outraster, 'integer') }
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!
- # perhaps via as.function(alist( )) ??
-
- 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]]) )
+
+ vallist <- list()
+ for (i in 1:length(rasters)) {
+ vallist[[i]] <- values(rasters[[i]])
+ clearValues(rasters[[i]])
}
+ vals <- do.call(fun, vallist)
outraster <- setValues(outraster, vals)
if (filename(outraster) != "") {
@@ -90,17 +80,14 @@
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]]) )
+
+
+ for (i in 1:length(rasters)) {
+ vallist[[i]] <- values(rasters[[i]])
+ clearValues(rasters[[i]])
}
+ vals <- do.call(fun, vallist)
+
if (filename(outraster) == "") {
# v <- c(v, vals)
startcell <- endcell + 1
Modified: pkg/raster/R/conversion.R
===================================================================
--- pkg/raster/R/conversion.R 2009-01-29 06:32:28 UTC (rev 208)
+++ pkg/raster/R/conversion.R 2009-01-29 08:48:45 UTC (rev 209)
@@ -86,13 +86,20 @@
setMethod('asRasterLayer', signature(object='SpatialPixelsDataFrame', index='numeric'),
function(object, index){
raster <- asRasterLayer(as(object, "SpatialPixels"))
- cells <- object at grid.index
- if (length(cells)==0) {
- cells <- cellFromXY(raster, object at coords)
- }
dindex <- max(1, min(dim(object at data)[2], index))
if (dindex != index) { warning(paste("index was changed to", dindex))}
- raster <- setValuesSparse(raster, cells, object at data[[dindex]])
+ sparse <- FALSE
+ if (!sparse) {
+ object <- as(object, 'SpatialGridDataFrame')
+ raster <- setValues(raster, object at data[[dindex]])
+ } else {
+ cells <- object at grid.index
+ if (length(cells)==0) {
+ cells <- cellFromXY(raster, object at coords)
+ }
+ raster <- setValuesSparse(raster, cells, object at data[[dindex]])
+ }
+ return(raster)
}
)
Modified: pkg/raster/R/polygonToRaster.R
===================================================================
--- pkg/raster/R/polygonToRaster.R 2009-01-29 06:32:28 UTC (rev 208)
+++ pkg/raster/R/polygonToRaster.R 2009-01-29 08:48:45 UTC (rev 209)
@@ -32,10 +32,8 @@
if ((ua >= 0 & ua <= 1) & (ub >= 0 & ub <= 1) ) {
x <- x1 + ua * (x2 - x1)
y <- y1 + ua * (y2 - y1)
- outx <- x1 + (ua * (x2 - x1))
- outy <- y1 + (ua * (y2 - y1))
# print("C")
- return(c(outx, outy))
+ return(c(x, y))
} else {
# print("D")
return(NA)
@@ -104,8 +102,10 @@
}
raster <- setDatatype(raster, class(putvals[1]))
-
+ adj <- 0.49 * xres(raster)
v <- vector(length=0)
+ rxmn <- xmin(raster) + 0.1 * xres(raster)
+ rxmx <- xmax(raster) - 0.1 * xres(raster)
for (r in 1:nrow(raster)) {
rv <- rep(NA, ncol(raster))
ly <- yFromRow(raster, r)
@@ -124,10 +124,22 @@
mypoly <- sppoly at polygons[[i]]@Polygons[[j]]@coords
intersection <- .overlayLinePolygon(myline, mypoly)
if (nrow(intersection) > 0) {
- cols <- sort(colFromX(raster, intersection[,1]))
+ x <- sort(intersection[,1])
for (k in 1:round(nrow(intersection)/2)) {
- l <- (k * 2) - 1
- rv[cols[l]:cols[l+1]] <- putvals[i]
+ l <- (k * 2) - 1
+ x1 <- x[l]
+ x2 <- x[l+1]
+ if (x1 > rxmx) { next }
+ if (x2 < rxmn) { next }
+ # adjust to skip first cell if the center is not covered by this polygon
+ x1a <- x1 + adj
+ x2a <- x2 - adj
+ x1a <- max(rxmn, x1a)
+ x2a <- min(rxmx, x2a)
+ col1 <- colFromX(raster, x1a)
+ col2 <- colFromX(raster, x2a)
+ if (is.na(col1) | is.na(col2) | col1 > col2) { next }
+ rv[col1:col2] <- putvals[i]
}
}
}
@@ -137,7 +149,7 @@
if (filename == "") {
v <- c(v, rv)
} else {
- raster <- setValues(raster, rv, r)
+ raster <- setValues(raster, values=rv, rownr=r)
raster <- writeRaster(raster)
}
}
Modified: pkg/raster/R/values.R
===================================================================
--- pkg/raster/R/values.R 2009-01-29 06:32:28 UTC (rev 208)
+++ pkg/raster/R/values.R 2009-01-29 08:48:45 UTC (rev 209)
@@ -1,4 +1,3 @@
-
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
# Date : June 2008
More information about the Raster-commits
mailing list