[Raster-commits] r256 - pkg/raster/R

[noreply at r-forge.r-project.org]

Author: rhijmans
Date: 2009-02-07 17:02:24 +0100 (Sat, 07 Feb 2009)
New Revision: 256

Modified:
   pkg/raster/R/polygonToRaster.R
Log:


Modified: pkg/raster/R/polygonToRaster.R
===================================================================
--- pkg/raster/R/polygonToRaster.R	2009-02-07 11:46:16 UTC (rev 255)
+++ pkg/raster/R/polygonToRaster.R	2009-02-07 16:02:24 UTC (rev 256)
@@ -108,7 +108,6 @@
 	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))
 		holes <- rep(FALSE, ncol(raster))
 		
@@ -124,37 +123,50 @@
 					if ( max ( spPolys at polygons[[i]]@Polygons[[j]]@coords[,2] ) < ly  |  min( spPolys at polygons[[i]]@Polygons[[j]]@coords[,2] ) > ly ) {
 						# polygon part above or below row. do nothing
 					} else {
-						mypoly <- spPolys at polygons[[i]]@Polygons[[j]]@coords
-						intersection <- .intersectLinePolygon(myline, mypoly)
-
+						mypoly <- spPolys at polygons[[i]]@Polygons[[j]]
+						intersection <- .intersectLinePolygon(myline, mypoly at coords)
+						
 						if (nrow(intersection) > 0) {
-							x <- sort(intersection[,1])
-							for (k in 1:round(nrow(intersection)/2)) {
-								l <- (k * 2) - 1		
-								x1 <- x[l]
-								x2 <- x[l+1]
-								if (is.na(x2)) { 
-									txt <- paste('something funny at row:', r, 'polygon:',j)
-									print(txt)
-									warning(txt)
-									x2 <- x1 
-								}
-								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 <- min(rxmx, max(rxmn, x1a))
-								x2a <- min(rxmx, max(rxmn, x2a))
-								col1 <- colFromX(raster, x1a)
-								col2 <- colFromX(raster, x2a)
-								if (col1 > col2) { next }
-
+							if ( sum(intersection[-length(intersection)] == intersection[-1]) > 0 ) {
+#								line1 <- myline
+#								line2 <- myline
+#								line1[,2] <-  myline[,2] + 0.1 * yres(raster)
+#								line2[,2] <-  myline[,2] - 0.1 * yres(raster)			
+								spPnts <- xyFromCell(raster, cellFromRowCol(raster, rep(r, ncol(raster)), 1:ncol(raster)), TRUE)
+								spPol <- SpatialPolygons(list(Polygons(list(mypoly), 1)))
+								over <- overlay(spPnts, spPol)
 								if ( spPolys at polygons[[i]]@Polygons[[j]]@hole ) {
-									holes[col1:col2] <- TRUE
+									holes[over] <- TRUE
 								} else {
-									rv[col1:col2] <- putvals[i]
+									rv[over] <- putvals[i]
 								}
+							} else {
+								x <- sort(intersection[,1])
+								for (k in 1:round(nrow(intersection)/2)) {
+									l <- (k * 2) - 1		
+									x1 <- x[l]
+									x2 <- x[l+1]
+									if (is.na(x2)) { 
+										txt <- paste('something funny at row:', r, 'polygon:',j)
+										error(txt)
+									}
+									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 <- min(rxmx, max(rxmn, x1a))
+									x2a <- min(rxmx, max(rxmn, x2a))
+									col1 <- colFromX(raster, x1a)
+									col2 <- colFromX(raster, x2a)
+									if (col1 > col2) { next }
+								
+									if ( spPolys at polygons[[i]]@Polygons[[j]]@hole ) {
+										holes[col1:col2] <- TRUE
+									} else {
+										rv[col1:col2] <- putvals[i]							
+									}
+								}
 							}	
 						}
 					}