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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jan 27 08:27:51 CET 2009


Author: rhijmans
Date: 2009-01-27 08:27:51 +0100 (Tue, 27 Jan 2009)
New Revision: 190

Modified:
   pkg/raster/R/compare.logical.functions.R
   pkg/raster/R/raster.create.R
   pkg/raster/R/read.raster.R
   pkg/raster/R/set.R
   pkg/raster/R/writeRaster.R
Log:
improved logical data handling

Modified: pkg/raster/R/compare.logical.functions.R
===================================================================
--- pkg/raster/R/compare.logical.functions.R	2009-01-27 07:24:54 UTC (rev 189)
+++ pkg/raster/R/compare.logical.functions.R	2009-01-27 07:27:51 UTC (rev 190)
@@ -46,11 +46,11 @@
 		}
 		if (.CanProcessInMemory(e1, 2)) {
 			raster <- setRaster(e1)
-			raster <- setDatatype(raster, datatype='integer', datasize=2)
+			raster <- setDatatype(raster, datatype='logical', datasize=2)
 			raster <- setValues(raster, values=callGeneric(.getRasterValues(e1), rep(e2, ncell(e1)) ) )			
 		} else {
 			raster <- setRaster(e1, filename=tempfile())
-			raster <- setDatatype(raster, datatype='integer', datasize=2)
+			raster <- setDatatype(raster, datatype='logical', datasize=2)
 			rowrep <- rep(e2, ncol(e1))
 			for (r in 1:nrow(e1)) {
 				raster <- setValues(raster, callGeneric( .getRowValues(e1, r), rowrep ), r)
@@ -68,11 +68,11 @@
 		}
 		if (.CanProcessInMemory(e2, 2)) {
 			raster <- setRaster(e2)
-			raster <- setDatatype(raster, datatype='integer', datasize=2)
+			raster <- setDatatype(raster, datatype='logical', datasize=2)
 			raster <- setValues(raster, callGeneric(.getRasterValues(e2), rep(e1, ncell(e2)) ) )
 		} else {
 			raster <- setRaster(e2, filename=tempfile())
-			raster <- setDatatype(raster, datatype='integer', datasize=2)
+			raster <- setDatatype(raster, datatype='logical', datasize=2)
 			rowrep <- rep(e1, ncol(e2))
 			for (r in 1:nrow(e2)) {
 				raster <- setValues(raster, callGeneric( .getRowValues(e2, r), rowrep ), r)
@@ -91,11 +91,11 @@
 		}	
 		if (.CanProcessInMemory(e1, 2)) {
 			raster <- setRaster(e1) 
-			raster <- setDatatype(raster, datatype='integer', datasize=2)
+			raster <- setDatatype(raster, datatype='logical', datasize=2)
 			raster <- setValues(raster, callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) ) 
 		} else {
 			raster <- setRaster(e1, filename=tempfile())
-			raster <- setDatatype(raster, datatype='integer', datasize=2)
+			raster <- setDatatype(raster, datatype='logical', datasize=2)
 			for (r in 1:nrow(e1)) {
 				raster <- setValues(raster, callGeneric( .getRowValues(e1, r), .getRowValues(e2, r) ), r)
 				raster <- writeRaster(raster)
@@ -114,11 +114,11 @@
 		if ( compare(c(e1, e2)) ) {
 			if (.CanProcessInMemory(e1, 2)) {
 				raster <- setRaster(e1)
-				raster <- setDatatype(raster, datatype='integer', datasize=2)
+				raster <- setDatatype(raster, datatype='logical', datasize=2)
 				raster <- setValues(raster, callGeneric(.getLogicalValues(e1), .getLogicalValues(e2)))
 			} else {
 				raster <- setRaster(e1, filename=tempfile())
-				raster <- setDatatype(raster, datatype='integer', datasize=2)	
+				raster <- setDatatype(raster, datatype='logical', datasize=2)	
 				for (r in 1:nrow(e1)) {
 					raster <- setValues(raster, callGeneric( .getLogicalRowValues(e1, r), .getLogicalRowValues(e2, r) ), r)
 					raster <- writeRaster(raster)
@@ -134,7 +134,7 @@
 setMethod("is.na", signature(x='RasterLayer'),
 	function(x) {
 		raster <- setRaster(x)
-		raster <- setDatatype(raster, datatype='integer', datasize=2)
+		raster <- setDatatype(raster, datatype='logical', datasize=2)
 		return(setValues(raster, is.na(.getRasterValues(x))))
 	}
 )	
@@ -142,7 +142,7 @@
 setMethod("is.nan", signature(x='RasterLayer'),
 	function(x) {
 		raster <- setRaster(x)
-		raster <- setDatatype(raster, datatype='integer', datasize=2)
+		raster <- setDatatype(raster, datatype='logical', datasize=2)
 		return(setValues(raster, is.nan(.getRasterValues(x))))
 	}
 )	
@@ -150,7 +150,7 @@
 setMethod("is.infinite", signature(x='RasterLayer'),
 	function(x) {
 		raster <- setRaster(x)
-		raster <- setDatatype(raster, datatype='integer', datasize=2)
+		raster <- setDatatype(raster, datatype='logical', datasize=2)
 		return(setValues(raster, values=is.infinite(.getRasterValues(x))))
 	}
 )	
@@ -158,7 +158,7 @@
 setMethod("is.finite", signature(x='RasterLayer'),
 	function(x) {
 		raster <- setRaster(x)
-		raster <- setDatatype(raster, datatype='integer', datasize=2)
+		raster <- setDatatype(raster, datatype='logical', datasize=2)
 		return(setValues(raster, values=is.finite(.getRasterValues(x))))
 	}
 )	

Modified: pkg/raster/R/raster.create.R
===================================================================
--- pkg/raster/R/raster.create.R	2009-01-27 07:24:54 UTC (rev 189)
+++ pkg/raster/R/raster.create.R	2009-01-27 07:27:51 UTC (rev 190)
@@ -36,9 +36,9 @@
 rasterFromFile <- function(filename, values=FALSE, band=1) {
 	fileext <- toupper(fileExtension(filename)) 
 	if (fileext == ".RASTER" | fileext == ".GRD") {
-		raster <- .rasterFromFileBinary(filename, band) 
+		raster <- .rasterFromFile(filename, band) 
 	} else {
-		raster <- .rasterFromFileGDAL(filename, band) 
+		raster <- .rasterFromGDAL(filename, band) 
 	}
 	if (values) {
 		raster <- readAll(raster)
@@ -46,7 +46,7 @@
 	return(raster)
 }	
 	
-.rasterFromFileGDAL <- function(filename, band) {	
+.rasterFromGDAL <- function(filename, band) {	
 	gdalinfo <- GDALinfo(filename)
 	nc <- as.integer(gdalinfo[["columns"]])
 	nr <- as.integer(gdalinfo[["rows"]])
@@ -101,7 +101,7 @@
 
 
 
-.rasterFromFileBinary <- function(filename, band=1) {
+.rasterFromFile <- function(filename, band=1) {
 	ini <- readIniFile(filename)
 	ini[,2] = toupper(ini[,2]) 
 
@@ -111,6 +111,8 @@
 	bandorder <- "BSQ"
 	ncellvals <- -9
 	projstring <- ""
+	minval <- NA
+	maxval <- NA
 	
 	for (i in 1:length(ini[,1])) {
 		if (ini[i,2] == "MINX") {xn <- as.numeric(ini[i,3])} 
@@ -147,6 +149,8 @@
 	
 	inidatatype <- trim(inidatatype)
 	if (substr(inidatatype, 1, 3) == "INT") { datatp="integer"
+	} else if (substr(inidatatype, 1, 3) == "LOG") { datatp="logical"
+	} else if (substr(inidatatype, 1, 3) == "ASC") { datatp="ascii"
 	} else { datatp="numeric" }
 	datasz <- as.integer(substr(inidatatype, 4, 4))
 	raster <- setDatatype(raster, datatype=datatp, datasize=datasz)

Modified: pkg/raster/R/read.raster.R
===================================================================
--- pkg/raster/R/read.raster.R	2009-01-27 07:24:54 UTC (rev 189)
+++ pkg/raster/R/read.raster.R	2009-01-27 07:27:51 UTC (rev 190)
@@ -60,10 +60,12 @@
 			stop(paste(filename(raster)," does not exist"))
 		}
 		con <- file(rastergri, "rb")
-		if (raster at file@datatype == "integer") { 
-			dtype <- integer()
+		if (raster at file@datatype == "ascii") {
+			stop("this type of ascii raster is not supported yet")
+		} else if (raster at file@datatype == "integer" | raster at file@datatype == "logical" ) { 
+			dtype <- "integer"
 		} else { 
-			dtype <- numeric() 
+			dtype <- "numeric" 
 		}
 		if (rownr > 0) {
 			seek(con, ((rownr-1) * ncol(raster) + (startcol-1)) * raster at file@datasize)
@@ -74,6 +76,9 @@
 		close(con)
 		result[is.nan(result)] <- NA
 		result[result <=  (0.999 * .nodatavalue(raster)) ] <- NA 
+		if (raster at file@datatype == 'logical') {
+			result <- as.logical(result)
+		}
 	}
 	else { #use GDAL  
 		if (is.na(raster at file@band)) { result <- NA }

Modified: pkg/raster/R/set.R
===================================================================
--- pkg/raster/R/set.R	2009-01-27 07:24:54 UTC (rev 189)
+++ pkg/raster/R/set.R	2009-01-27 07:27:51 UTC (rev 190)
@@ -134,13 +134,17 @@
 	} else {
 		vals <- na.omit(values(raster)) # min and max values
 		if (length(vals) > 0) {
-			raster at data@min <-  min(vals)
+			raster at data@min <- min(vals)
 			raster at data@max <- max(vals)
 		} else {
 			raster at data@min <- NA
 			raster at data@max <- NA
 		}
-	}	
+	}
+#	if (raster at file@datatype == 'logical') {
+#		raster at data@min <- as.logical(min(raster at data@min))
+#		raster at data@max <- as.logical(max(raster at data@max))
+#	}
 	raster at data@haveminmax <- TRUE
 	return(raster)
 }
@@ -192,13 +196,11 @@
 		} else {
 			stop("invalid datasize for this datatype") 
 		}
-#	} else if ( datatype == 'logical' ) {
-#		raster at file@datatype <- datatype 
-#		raster at data@min <- round(minValue(raster))
-#		raster at data@max <- round(maxValue(raster))
-#		raster at file@datasize <- as.integer(2)
-#		raster at file@nodatavalue <- -32768
-#		raster at file@datanotation <- "LOGICAL"
+	} else if ( datatype == 'logical' ) {
+		raster at file@datatype <- datatype 
+		raster at file@datasize <- as.integer(1)
+		raster at file@nodatavalue <- -126
+		raster at file@datanotation <- "LOGICAL"
 	} else {
 		stop("unknown datatype")
 	} 

Modified: pkg/raster/R/writeRaster.R
===================================================================
--- pkg/raster/R/writeRaster.R	2009-01-27 07:24:54 UTC (rev 189)
+++ pkg/raster/R/writeRaster.R	2009-01-27 07:27:51 UTC (rev 190)
@@ -34,16 +34,22 @@
 		if (xmin(raster) > -32767 & xmax(raster) < 32768) {
 			raster <- setDatatype(raster, 'integer', datasize=2)
 			raster at data@values <- as.integer(round(values(raster)))
+			raster at data@values[is.na(raster at data@values)] <- as.integer(raster at file@nodatavalue)						
 		} else if (xmin(raster) > -2147483647 & xmax(raster) < 2147483648 ) {
 			raster <- setDatatype(raster, 'integer', datasize=4)
 			raster at data@values <- as.integer(round(values(raster)))
+			raster at data@values[is.na(raster at data@values)] <- as.integer(raster at file@nodatavalue)			
 		} else if (xmin(raster) > -(2^63/2) & xmax(raster) < (2^64/2)) {
 			raster <- setDatatype(raster, 'integer', datasize=8)
 			raster at data@values <- as.integer(round(values(raster)))
+			raster at data@values[is.na(raster at data@values)] <- as.integer(raster at file@nodatavalue)			
 		} else {
 			raster <- setDatatype(raster, 'numeric', datasize=8)
 			raster at data@values <- as.numeric(values(raster))
 		}
+	} else if ( raster at file@datatype =='logical') {
+		raster at data@values <- as.integer(values(raster))
+		raster at data@values[is.na(raster at data@values)] <- as.integer(raster at file@nodatavalue)
 	} else {
 		if (xmin(raster) < -3.4E38 | xmax(raster) > 3.4E38) {
 			raster <- setDatatype(raster, 'numeric', 8)
@@ -52,15 +58,24 @@
 		}	
 	}
 
+
+
 	if (raster at data@content == 'sparse') { 
 		raster <- .writeSparse(raster, overwrite=overwrite) 
 	} else {
 		binraster <- .setFileExtensionValues(filename(raster))
 		con <- file(binraster, "wb")
+		print(raster at file@datasize)
 		writeBin( values(raster), con, size = raster at file@datasize) 
 		close(con)
 		.writeRasterHdr(raster) 
 	}	
+	
+	# put logical values back to T/F
+	if ( raster at file@datatype =='logical') {
+		raster at data@values <- as.logical(values(raster))
+	}
+	
 	return(raster)
 }
  
@@ -98,19 +113,27 @@
 	if (dataContent(raster) != 'row') { 
 		stop('raster does not contain a row') 
 	}
+	
+	
 	if (raster at file@datatype == "integer") { 
 		raster at data@values <- as.integer(round(raster at data@values))  
 	}
 	if (class(values(raster)) == "integer" & raster at file@datatype == "numeric") { 
 		raster at data@values  <- as.numeric(values(raster)) 
 	}
+	if ( raster at file@datatype =='logical') {
+	# values should be written as 0 / 1 ( integers)
+		raster at data@values <- as.integer(values(raster))
+	}
+		
+	
 	if (dataIndices(raster)[1] == 1) { 
 		raster <- ..startWriting(raster, overwrite=overwrite)
  	} 
 	
 	raster at data@values[is.nan(raster at data@values)] <- NA
 	raster at data@values[is.infinite(raster at data@values)] <- NA
-
+	
 	writeBin(raster at data@values, raster at filecon, size = raster at file@datasize)
 	
 	if (dataIndices(raster)[2] >= ncell(raster)) {
@@ -176,9 +199,13 @@
 		datatype <- "ASC" 
 	} else if (raster at file@datatype == 'integer') {  
 		datatype <- "INT"  
+	} else if (raster at file@datatype == 'logical') {  
+		datatype <- "LOG" 
 	} else { 
 		datatype <- "FLT" 
 	}
+	
+	
 	if (datatype != "ASC") {
 		datatype <- paste(datatype, raster at file@datasize, "BYTES", sep="")
 		cat("DataType=",  datatype, "\n", file = thefile)



More information about the Raster-commits mailing list