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

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

Author: rhijmans
Date: 2009-01-28 10:20:32 +0100 (Wed, 28 Jan 2009)
New Revision: 200

Added:
   pkg/raster/R/point2raster.R
Modified:
   pkg/raster/R/conversion.R
   pkg/raster/R/properties.R
   pkg/raster/R/readSurfer.R
   pkg/raster/R/stack.R
Log:


Modified: pkg/raster/R/conversion.R
===================================================================
--- pkg/raster/R/conversion.R	2009-01-28 05:59:38 UTC (rev 199)
+++ pkg/raster/R/conversion.R	2009-01-28 09:20:32 UTC (rev 200)
@@ -61,13 +61,14 @@
 
 setMethod('asRasterLayer', signature(object='RasterStack', index='numeric'), 
 	function(object, index){
-		rs <- newRaster(xmn = xmin(object), xmx = xmax(object), ymn = ymin(object), ymx = ymax(object), nrows=nrow(object), ncols=ncol(object), projstring=projection(object))
-		if (dataContent(object) == 'all') {
-			dindex <- max(1, min(nlayers(object), index))
-			if (dindex != index) { warning(paste("index was changed to", dindex))}
-			rs <- setValues(rs, as.matrix(values(object))[,dindex])
-		}
-		return(rs)
+		dindex <- max(1, min(nlayers(object), index))
+		if (dindex != index) { warning(paste("index was changed to", dindex))}
+		rs <- object at layers[[dindex]]
+#		rs <- newRaster(xmn = xmin(object), xmx = xmax(object), ymn = ymin(object), ymx = ymax(object), nrows=nrow(object), ncols=ncol(object), projstring=projection(object))
+#		if (dataContent(object) == 'all') {
+#			rs <- setValues(rs, as.matrix(values(object))[,dindex])
+#		}
+#		return(rs)
 	}
 )
 

Added: pkg/raster/R/point2raster.R
===================================================================
--- pkg/raster/R/point2raster.R	                        (rev 0)
+++ pkg/raster/R/point2raster.R	2009-01-28 09:20:32 UTC (rev 200)
@@ -0,0 +1,52 @@
+
+pointsToRaster <- function(raster, xy, values, fun=length, filename="", overwrite=FALSE) {
+	if (class(xy) != 'matrix') {stop('xy must be a matrix')}
+	if (length(values) != length(xy[,1])) {stop('values must be a vector of length=length(xy[,1])')}
+	
+	xya <- cbind(xy, values)
+	rs <- setRaster(raster, filename)
+	cells <- cellFromXY(rs, xya[,1:2])
+	rows <- rowFromCell(rs, cells)
+	cols <- colFromCell(rs, cells)
+	xyarc <- cbind(xya, rows, cols)
+	urows <- unique(rows)
+	urows <- urows[order(urows)]
+#	allrows <- seq(1:nrow(rs))
+#	allrows <- cbind(allrows, FALSE)
+#	allrows[urows, 2] <- TRUE
+	d <- vector(length=ncol(rs))
+	d[] <- NA
+	dna <- d
+	v <- vector(length=0)	
+	for (r in 1 : rs at nrows) {
+#		if (!allrows[r, 2]) {	
+		if (r %in% urows) {
+			ss <- subset(xyarc, xyarc[,4] == r)
+			cols <- ss[,5]
+			ucols <- unique(cols)
+			ucols <- ucols[order(ucols)]
+			d <- dna
+			for (c in 1:length(ucols)) {
+				sss <- subset(ss, ss[,5] == ucols[c] )
+				d[ucols[c]] <- fun(sss[,3])	
+			}
+			if (filename != "") {
+				rs <- setValues(rs, d, r)
+				rs <- writeRaster(rs)
+			} else {
+				v <- c(v, d)
+			}
+		} else {
+			if (filename != "") {
+				rs <- setValues(rs, dna, r)
+				rs <- writeRaster(rs, r) 
+			} else {
+				v <- c(v, dna)
+			}
+		} 
+	}	
+	if (filename == "") {
+		rs <- setValues(rs, v)
+	}
+	return(rs)
+}

Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R	2009-01-28 05:59:38 UTC (rev 199)
+++ pkg/raster/R/properties.R	2009-01-28 09:20:32 UTC (rev 200)
@@ -161,16 +161,12 @@
 	if (class(object) == "RasterLayer") {
 		return(object at file@band)
 	} else {
-		stop("only implemented for RasterLayer objects")
-	}	
+		stop(paste("not implemented for:", class(object), "objects"))
+	}
 }
 
 nbands <- function(object) {
-	if (class(object) == "RasterLayer") {
-		return(1)
-	} else {
-		return(object at file@nbands)
-	}	
+	return(object at file@nbands)
 }
 
 projection <- function(object, asText=TRUE) {

Modified: pkg/raster/R/readSurfer.R
===================================================================
--- pkg/raster/R/readSurfer.R	2009-01-28 05:59:38 UTC (rev 199)
+++ pkg/raster/R/readSurfer.R	2009-01-28 09:20:32 UTC (rev 200)
@@ -17,6 +17,7 @@
 	m <- matrix(v, nrow=r at rows, ncol=r at ncol, byrow=T)
 	m <- m[nrow(m):1, ] 
 	r <- setValues(r, as.vector(t(m)))
+	r at file@driver <- "surfer"
 	return(r)
 }
 

Modified: pkg/raster/R/stack.R
===================================================================
--- pkg/raster/R/stack.R	2009-01-28 05:59:38 UTC (rev 199)
+++ pkg/raster/R/stack.R	2009-01-28 09:20:32 UTC (rev 200)
@@ -58,10 +58,24 @@
 } )
 
 
-addFiles <- function(rstack, rasterfiles, bands= rep(1, length(rasterfiles))) {
+addFiles <- function(rstack, rasterfiles, bands=rep(1, length(rasterfiles))) {
+	if (length(bands) == 1) {
+		bands=rep(bands, length(rasterfiles))
+	} 
 	rasters <- list()
 	for (i in 1:length(rasterfiles)) { 
-		rasters <- c(rasters, rasterFromFile(rasterfiles[[i]], FALSE, band=bands[[i]]))
+		if (bands[[i]] < 1) {
+			r <- rasterFromFile(rasterfiles[[i]], band=1)
+			rasters <- c(rasters, r)
+			if (nbands(r) > 1) {
+				for (j in 2:nbands(r)) {
+					r <- rasterFromFile(rasterfiles[[i]], band=j)
+					rasters <- c(rasters, r)
+				}
+			}
+		} else {
+			rasters <- c(rasters, rasterFromFile(rasterfiles[[i]], FALSE, band=bands[[i]]))
+		}
 	}	
 	rstack <- addRasters(rstack, rasters) 
 	return(rstack)