[Raster-commits] r228 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jan 31 11:28:59 CET 2009
Author: rhijmans
Date: 2009-01-31 11:28:59 +0100 (Sat, 31 Jan 2009)
New Revision: 228
Added:
pkg/raster/man/LinesToRaster.Rd
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/linesToRaster.R
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-01-31 09:13:36 UTC (rev 227)
+++ pkg/raster/DESCRIPTION 2009-01-31 10:28:59 UTC (rev 228)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.7-6
-Date: 30-Jan-2009
+Version: 0.8.7-7
+Date: 31-Jan-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/R/linesToRaster.R
===================================================================
--- pkg/raster/R/linesToRaster.R 2009-01-31 09:13:36 UTC (rev 227)
+++ pkg/raster/R/linesToRaster.R 2009-01-31 10:28:59 UTC (rev 228)
@@ -1,7 +1,7 @@
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
-# Date : June 2008
-# Version 0,1
+# Date : January 2009
+# Version 0.8
# Licence GPL v3
.specialRowFromY <- function(object, y) {
@@ -21,33 +21,35 @@
}
-getCols <- function(rs, rownr, segment, line1, line2) {
+.getCols <- function(rs, rownr, segment, line1, line2) {
# for a simple line (connecting 2 points) and a single poly
rows <- .specialRowFromY(rs, segment[,2])
- if (rows[1] > rownr & rows[2] > rownr | rows[1] < rownr & rows[2] < rownr) { return(NA) }
+ if ((rows[1] > rownr & rows[2] > rownr) | (rows[1] < rownr & rows[2] < rownr)) { return(NA) }
cols <- .specialColFromX(rs,segment[,1])
rowcol <- cbind(rows, cols)[order(cols),]
- if (rows[1] == rows[2]) {
+ if (rowcol[1,2] == rowcol[2,2]) {
return(rowcol[1,2]:rowcol[2,2])
} else {
- if (rowcol[1,1] == rownr) {
- col1 <- rowcol[1,2]
+ if (rowcol[1,1] == rownr ) {
if (rowcol[2,1] < rownr) {
xy <- .intersectSegments(line1[1,1], line1[1,2], line1[2,1], line1[2,2], segment[1,1], segment[1,2], segment[2,1], segment[2,2] )
} else {
xy <- .intersectSegments(line2[1,1], line2[1,2], line2[2,1], line2[2,2], segment[1,1], segment[1,2], segment[2,1], segment[2,2] )
}
xy <- t(as.matrix(xy))
- col2 <- max(colFromX(rs, xy[,1]))
+ cols <- c(rowcol[1,2], colFromX(rs, xy[,1]))
+ col1 <- min(cols)
+ col2 <- max(cols)
} else if (rowcol[2,1] == rownr) {
- col1 <- rowcol[2,2]
if (rowcol[1,1] < rownr) {
xy <- .intersectSegments(line1[1,1], line1[1,2], line1[2,1], line1[2,2], segment[1,1], segment[1,2], segment[2,1], segment[2,2] )
} else {
xy <- .intersectSegments(line2[1,1], line2[1,2], line2[2,1], line2[2,2], segment[1,1], segment[1,2], segment[2,1], segment[2,2] )
}
xy <- t(as.matrix(xy))
- col2 <- max(colFromX(rs, xy[,1]))
+ cols <- c(rowcol[2,2], colFromX(rs, xy[,1]))
+ col1 <- min(cols)
+ col2 <- max(cols)
} else {
xy1 <- .intersectSegments(line1[1,1], line1[1,2], line1[2,1], line1[2,2], segment[1,1], segment[1,2], segment[2,1], segment[2,2] )
xy2 <- .intersectSegments(line2[1,1], line2[1,2], line2[2,1], line2[2,2], segment[1,1], segment[1,2], segment[2,1], segment[2,2] )
@@ -61,9 +63,6 @@
}
-
-
-
linesToRaster <- function(spLines, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA") {
filename <- trim(filename)
if (updateRaster) {
@@ -119,26 +118,28 @@
line1 <- rbind(c(lxmin, ly + 0.5*yres(raster)), c(lxmax,ly + 0.5*yres(raster)))
line2 <- rbind(c(lxmin, ly - 0.5*yres(raster)), c(lxmax,ly - 0.5*yres(raster)))
- uly <- ly + 0.01 * yres(raster)
- lly <- ly - 0.01 * yres(raster)
+ uly <- ly + 0.51 * yres(raster)
+ lly <- ly - 0.51 * yres(raster)
for (i in 1:nline) {
if (info[i,2] > uly | info[i,3] < lly) {
# do nothing
} else {
for (j in 1:info[i,1]) {
- if ( max ( spLines at lines[[i]]@Lines[[j]]@coords[,2] ) < ly | min( spLines at lines[[i]]@Lines[[j]]@coords[,2] ) > ly ) {
+ if ( max ( spLines at lines[[i]]@Lines[[j]]@coords[,2] ) < lly | min( spLines at lines[[i]]@Lines[[j]]@coords[,2] ) > uly ) {
# do nothing
} else {
- segment <- spLines at lines[[i]]@Lines[[j]]@coords
- colnrs <- getCols(raster, r, segment, line1, line2)
- if ( length(colnrs) > 0 ) {
- rv[colnrs] <- putvals[i]
+ aline <- spLines at lines[[i]]@Lines[[j]]@coords
+ for (k in 1:(nrow(aline)-1) ) {
+ segment <- aline[k:(k+1),]
+ colnrs <- .getCols(raster, r, segment, line1, line2)
+ if ( length(colnrs) > 0 ) {
+ rv[colnrs] <- putvals[i]
+ }
}
- }
+ }
}
}
- }
-
+ }
if (updateRaster) {
oldvals <- values(readRow(oldraster, r))
if (updateValue == "all") {
Added: pkg/raster/man/LinesToRaster.Rd
===================================================================
--- pkg/raster/man/LinesToRaster.Rd (rev 0)
+++ pkg/raster/man/LinesToRaster.Rd 2009-01-31 10:28:59 UTC (rev 228)
@@ -0,0 +1,45 @@
+\name{lines to raster}
+
+\alias{linesToRaster}
+
+\title{ Transform polygons to a raster }
+\description{
+ Lines to raster conversion
+}
+\usage{
+linesToRaster(spLines, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA")
+}
+
+\arguments{
+ \item{spLines}{ a SpatialLines or a SpatialLinesDataFrame object (sp package)}
+ \item{raster}{ a RasterLayer object}
+ \item{field}{ The index of the column in the SpatialPolygonsDataFrame to be transfered to the RasterLayer }
+ \item{filename}{ output filename }
+ \item{overwrite}{ logical. if \code{TRUE} ouput file will be overwritten if it exists }
+ \item{updateRaster}{logical. If \code{TRUE} the values of the input RasterLayer are updated where the polygons overlap cells }
+ \item{updateValue}{character. Select cells to be updated (if \code{updateRaster == TRUE}) by their current values. Either 'all', 'NA', '!NA', or 'zero' }
+}
+
+\details{
+ For SpatialLines, the 'field' argument is ignored. The line index is used
+}
+
+\author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
+
+\seealso{ \code{\link[rgdal]{rgdal}} }
+\examples{
+
+cds1 <- rbind(c(-50,0), c(0,60), c(40,5), c(15,-45), c(-10,-25))
+cds2 <- rbind(c(80,20), c(140,60), c(160,0), c(140,-55))
+cds3 <- rbind(c(-180,-20), c(-140,-60), c(-60,-20), c(-140,55))
+
+lines <- SpatialLines(list(Lines(list(Line(cds1)), "1"), Lines(list(Line(cds2)), "2"), Lines(list(Line(cds3)), "3") ))
+
+r <- raster(ncols=90, nrows=45)
+r <- linesToRaster(lines, r)
+plot(r)
+plot(lines, add=TRUE)
+
+}
+
+\keyword{ spatial }
More information about the Raster-commits
mailing list