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

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

Author: rhijmans
Date: 2009-05-03 03:52:16 +0200 (Sun, 03 May 2009)
New Revision: 439

Modified:
   pkg/raster/R/disaggregate.R
   pkg/raster/R/valuesRow.R
Log:


Modified: pkg/raster/R/disaggregate.R
===================================================================
--- pkg/raster/R/disaggregate.R	2009-05-02 12:36:04 UTC (rev 438)
+++ pkg/raster/R/disaggregate.R	2009-05-03 01:52:16 UTC (rev 439)
@@ -19,50 +19,44 @@
 	} else {
 		stop('length(fact) should be 1 or 2')
 	}
-	
-	outraster <- raster(raster, filename)
+	filename <- trim(filename)
+	outraster <- raster(raster)
 	dataType(outraster) <- datatype
 	rowcol(outraster) <- c(nrow(raster) * yfact, ncol(raster) * xfact) 
+
+	if (dataContent(raster) == 'nodata' & dataSource(raster) == 'ram') {
+		return(outraster)
+	}
 	
-	if ( dataContent(raster)=='all') {
-		
+	if (!canProcessInMemory(outraster, 3) && filename == '') {
+		filename <- rasterTmpFile()
+		if (options('verbose')[[1]]) { cat('writing raster to:', filename)	}						
+	}
+	filename(outraster) <- filename
+	
+	if ( filename == "" ) {
+		if (dataContent(raster) != 'all') {
+			raster <- readAll(raster)
+		}
 		cols <- rep(rep(1:ncol(raster), each=xfact), times=nrow(raster)*yfact)
 		rows <- rep(1:nrow(raster), each=ncol(raster)*xfact*yfact)
 		cells <- cellFromRowCol(raster, rows, cols)
 		outraster <- setValues(outraster, values(raster)[cells])
-		if (outraster at file@name != "") {
-			outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
-		}
 		
-	} else if ( dataSource(raster) == 'disk') { 
-		
-		if (!canProcessInMemory(outraster) && filename == '') {
-			filename <- rasterTmpFile()
-			filename(outraster) <- filename
-			if (options('verbose')[[1]]) { cat('writing raster to:', filename)	}						
-		}
-	
-		starttime <- proc.time()
-		
+	} else { 
+		# to speed up valuesRow
+		if (dataContent(raster) != 'all') { raster <- clearValues(raster) }
+		starttime <- proc.time()		
 		v <- vector(length=0)
 		cols <- rep(1:ncol(raster), each=xfact)
 		for (r in 1:nrow(raster)) {
-			raster <- readRow(raster, r)
+			vals <- valuesRow(raster, r)
 			for (i in 1:yfact) {
-			
-				if (outraster at file@name == "") {
-					v <- c(v, values(raster)[cols])
-				} else {
-					outraster <- setValues(outraster, values(raster)[cols], (r-1) * xfact + i)
-					outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
-				}	
+				outraster <- setValues(outraster, vals[cols], (r-1) * xfact + i)
+				outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
 			}	
+			if (r %in% track) { .showTrack(r, raster at nrows, track, starttime) }
 		}
-		if (outraster at file@name == "") { 
-			outraster <- setValues(outraster, v) 
-		}
-
-		if (r %in% track) { .showTrack(r, outraster at nrows, track, starttime) }
 	} 
 	return(outraster)
 }

Modified: pkg/raster/R/valuesRow.R
===================================================================
--- pkg/raster/R/valuesRow.R	2009-05-02 12:36:04 UTC (rev 438)
+++ pkg/raster/R/valuesRow.R	2009-05-03 01:52:16 UTC (rev 439)
@@ -5,24 +5,25 @@
 # Licence GPL v3
 
 
-
-
 valuesRow <- function(object, rownr) {
 	if (dataContent(object) == 'nodata') {
 		return(values(readRow(object, rownr)))
 	}
-	if (rownr < 0) {
-		if (dataContent(object) == 'all') {
-			return(object)
-		} else {
-			stop('cannot get these values')
-		}
-	}
 	if (!(validRow(object, rownr))) {
 		stop(paste(rownr,'is not a valid rownumber')) 
 	}
-	if (dataContent(object) == 'sparse') {
-		return (.valuesRow.sparse(object, rownr)) 
+
+	if (dataContent(object) == 'all'){
+		if (rownr < 0) {
+			return(values(object))
+		}
+		startcell <- cellFromRowCol(object, rownr, 1)
+		endcell <- startcell+ncol(object)-1
+		if (class(object) == 'RasterStack') {
+			return(values(object)[startcell:endcell,])
+		} else {	
+			return(values(object)[startcell:endcell])
+		}
 	} else if (dataContent(object) == 'row') {
 		startcell <- cellFromRowCol(object, rownr, 1)
 		endcell <- startcell+ncol(object)-1
@@ -35,12 +36,12 @@
 		firstcol <- colFromCell(object, dataIndices(object)[1])
 		lastcol <- colFromCell(object, dataIndices(object)[2])
 		if (firstcol != 1 | lastcol != ncol(object)) {
-			stop('the block data in this object does not have complete rows')
+			return(values(readRow(object, rownr)))
 		}
 		firstrow <- rowFromCell(object, dataIndices(object)[1])
 		lastrow <- rowFromCell(object, dataIndices(object)[2])
 		if (rownr < firstrow | rownr > lastrow) {
-			stop('this row is not in memory. First use readRow() or readAll')		
+			return(values(readRow(object, rownr)))
 		}
 		startcell <- ((rownr - firstrow) * ncol(object) + 1) 
 		endcell <- startcell + ncol(object) - 1
@@ -49,14 +50,8 @@
 		} else {	
 			return(values(object)[startcell:endcell])
 		}
-	} else if (dataContent(object) == 'all'){
-		startcell <- cellFromRowCol(object, rownr, 1)
-		endcell <- startcell+ncol(object)-1
-		if (class(object) == 'RasterStack') {
-			return(values(object)[startcell:endcell,])
-		} else {	
-			return(values(object)[startcell:endcell])
-		}
+	} else if (dataContent(object) == 'sparse') {
+		return (.valuesRow.sparse(object, rownr)) 
 	} else {
 		stop('something is wrong with the RasterLayer dataContent')
 	}