[Raster-commits] r455 - in pkg/raster: . R man

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

Author: rhijmans
Date: 2009-05-12 13:10:17 +0200 (Tue, 12 May 2009)
New Revision: 455

Modified:
   pkg/raster/DESCRIPTION
   pkg/raster/R/clump.R
   pkg/raster/R/rasterTmpFile.R
   pkg/raster/man/clump.Rd
Log:


Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION	2009-05-12 09:16:41 UTC (rev 454)
+++ pkg/raster/DESCRIPTION	2009-05-12 11:10:17 UTC (rev 455)
@@ -1,7 +1,7 @@
 Package: raster
 Type: Package
 Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.9-18
+Version: 0.8.9-19
 Date: 12-May-2009
 Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
 Author: Robert J. Hijmans & Jacob van Etten

Modified: pkg/raster/R/clump.R
===================================================================
--- pkg/raster/R/clump.R	2009-05-12 09:16:41 UTC (rev 454)
+++ pkg/raster/R/clump.R	2009-05-12 11:10:17 UTC (rev 455)
@@ -5,9 +5,10 @@
 # Licence GPL v3
 
 clump <- function(raster, filename=NULL, overwrite=FALSE, filetype='raster', datatype='INT4S', track=-1) {
-	cat('WARNING: this function does not return correct results', '\n')
-	
 	if (is.null(filename)) { filename <- "" }
+	if (filename != ""  & file.exists(filename) & overwrite==FALSE) {
+		stop("file exists. Use another name or 'overwrite=TRUE' if you want to overwrite it")
+	}
 	tmpfile1 <- ""
 	x1 <- raster(raster)
 	dataType(x1) <- datatype
@@ -26,6 +27,8 @@
 	c2 <- vector(length=nc)
 	c2[] <- 0
 	rcl <- matrix(NA, nrow=0, ncol=2)
+	
+	starttime <- proc.time()
 	for (r in 1:nrow(x1)) {
 		b <- valuesRow(raster, r)
 		c1 <- c2
@@ -47,7 +50,7 @@
 		}
 
 # check for joining clumps:
-		
+
 		for (cc in 1:nc) {
 			if (c2[cc] > 0) {
 				if (isTRUE(c1[cc] > 0) & isTRUE(c1[cc] != c2[cc])) {
@@ -65,46 +68,55 @@
 		if (tmpfile1 == "") {
 			v <- c(v, c2)
 		} else {
-			x1 <- setValues(x1, c2)
-			x1 <- writeRaster(x1, r)
+			x1 <- setValues(x1, c2, r)
+			x1 <- writeRaster(x1)
 		}	
+		
+		rcl <- unique(rcl)
+		if (r %in% track) { .showTrack(r, x1 at nrows, track, starttime) }
+
 	}
 	if (tmpfile1 == "") {
 		x1 <- setValues(x1, v)
 	}
-	rcl1 <- unique(rbind(rcl, cbind(rcl[,2], rcl[,1])))
-	rcl <- rcl1[rcl1[,1] > rcl1[,2],]
-	aggrcl1 <- aggregate(rcl, by=list(rcl[,1]), FUN=min)[,-1]
-	colnames(rcl) <- c('a', 'b')
-	colnames(aggrcl1) <- c('a', 'c')
-	aggrcl2 <- merge(rcl, aggrcl1)[,-1]
-	aggrcl2 <- aggrcl2[aggrcl2[,1] != aggrcl2[,2],]
-	colnames(aggrcl2)[1] <- 'a'
-	aggrcl <- rbind(aggrcl1, aggrcl2)
-	aggrcl <- aggregate(aggrcl, by=list(aggrcl[,1]), FUN=min)[,-1]
-	rcldown <- aggrcl[rev(order(aggrcl[,1])), ]
 	
-	rcl <- rcl1[rcl1[,1] < rcl1[,2],]
-	aggrcl1 <- aggregate(rcl, by=list(rcl[,1]), FUN=max)[,-1]
-	colnames(rcl) <- c('a', 'b')
-	colnames(aggrcl1) <- c('a', 'c')
-	aggrcl2 <- merge(rcl, aggrcl1)[,-1]
-	aggrcl2 <- aggrcl2[aggrcl2[,1] != aggrcl2[,2],]
-	colnames(aggrcl2)[1] <- 'a'
-	aggrcl <- rbind(aggrcl1, aggrcl2)
-	aggrcl <- aggregate(aggrcl, by=list(aggrcl[,1]), FUN=max)[,-1]
-	rclup <- aggrcl[order(aggrcl[,1]), ]
+	if (nrow(rcl) > 1) {
+		rcl1 <- unique(rbind(rcl, cbind(rcl[,2], rcl[,1])))
+		rcl <- rcl1[rcl1[,1] > rcl1[,2],]
+		aggrcl1 <- aggregate(rcl, by=list(rcl[,1]), FUN=min)[,-1]
+		colnames(rcl) <- c('a', 'b')
+		colnames(aggrcl1) <- c('a', 'c')
+		aggrcl2 <- merge(rcl, aggrcl1)[,-1]
+		aggrcl2 <- aggrcl2[aggrcl2[,1] != aggrcl2[,2],]
+		colnames(aggrcl2)[1] <- 'a'
+		aggrcl <- rbind(aggrcl1, aggrcl2)
+		aggrcl <- aggregate(aggrcl, by=list(aggrcl[,1]), FUN=min)[,-1]
+		rcldown <- aggrcl[rev(order(aggrcl[,1])), ]
 	
-	rclcomb <- rbind(rcldown, rclup)
+		rcl <- rcl1[rcl1[,1] < rcl1[,2],]
+		aggrcl1 <- aggregate(rcl, by=list(rcl[,1]), FUN=max)[,-1]
+		colnames(rcl) <- c('a', 'b')
+		colnames(aggrcl1) <- c('a', 'c')
+		aggrcl2 <- merge(rcl, aggrcl1)[,-1]
+		aggrcl2 <- aggrcl2[aggrcl2[,1] != aggrcl2[,2],]
+		colnames(aggrcl2)[1] <- 'a'
+		aggrcl <- rbind(aggrcl1, aggrcl2)
+		aggrcl <- aggregate(aggrcl, by=list(aggrcl[,1]), FUN=max)[,-1]
+		rclup <- aggrcl[order(aggrcl[,1]), ]
 	
-	rclm <- cbind(rclcomb[,1], rclcomb)
+		rclcomb <- rbind(rcldown, rclup, c(0, NA))
+		rclm <- cbind(rclcomb[,1], rclcomb)
+	} else {
+		rclm <- c(0, 0, NA)
+	}
 	if (tmpfile1 == "") {
-		x1 <- reclass(x1, rclm, update=TRUE, filename=filename, datatype=datatype, overwrite=overwrite)
+		x1 <- reclass(x1, rclm, update=TRUE, filename=filename, datatype=datatype, overwrite=overwrite, track=track)
 		return(x1)
 	} else {
-		x2 <- reclass(x1, rclm, update=TRUE, filename=filename, datatype=datatype, overwrite=overwrite)
+		x2 <- reclass(x1, rclm, update=TRUE, filename=filename, datatype=datatype, overwrite=overwrite, track=track)
 		removeRasterFile(x1)
 		return(x2)
 	}
 }	
 
+

Modified: pkg/raster/R/rasterTmpFile.R
===================================================================
--- pkg/raster/R/rasterTmpFile.R	2009-05-12 09:16:41 UTC (rev 454)
+++ pkg/raster/R/rasterTmpFile.R	2009-05-12 11:10:17 UTC (rev 455)
@@ -32,10 +32,11 @@
 
 removeTmpFiles <- function() {
 	d <- rasterTmpDir()
-	unlink(d)
+	unlink(paste(d,'/*', sep=""))
 }
 
 showTmpFiles <- function() {
 	d <- rasterTmpDir()
 	list.files(d, '.grd')
 }
+

Modified: pkg/raster/man/clump.Rd
===================================================================
--- pkg/raster/man/clump.Rd	2009-05-12 09:16:41 UTC (rev 454)
+++ pkg/raster/man/clump.Rd	2009-05-12 11:10:17 UTC (rev 455)
@@ -35,7 +35,7 @@
 r <- raster(ncols=50, nrows=50)
 r[] <- round(runif(ncell(r))*0.75 )
 rc <- clump(r) 
-
+#freq(rc)
 }
 \keyword{spatial}