[Raster-commits] r451 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 12 09:50:42 CEST 2009
Author: rhijmans
Date: 2009-05-12 09:50:38 +0200 (Tue, 12 May 2009)
New Revision: 451
Added:
pkg/raster/R/clump.R
pkg/raster/man/clump.Rd
Modified:
pkg/raster/R/click.R
pkg/raster/R/reclass.R
pkg/raster/man/reclass.Rd
Log:
Modified: pkg/raster/R/click.R
===================================================================
--- pkg/raster/R/click.R 2009-05-12 05:31:08 UTC (rev 450)
+++ pkg/raster/R/click.R 2009-05-12 07:50:38 UTC (rev 451)
@@ -29,7 +29,11 @@
if (class(object) == 'RasterStack') {
colnames(value) <- layerNames(object)
} else {
- colnames(value) <- 'value'
+ if (n==1) {
+ colnames(value) <- 'value'
+ } else {
+ colnames(value) <- paste('value', 1:n, sep="")
+ }
}
if (xy) {
Added: pkg/raster/R/clump.R
===================================================================
--- pkg/raster/R/clump.R (rev 0)
+++ pkg/raster/R/clump.R 2009-05-12 07:50:38 UTC (rev 451)
@@ -0,0 +1,120 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : May 2009
+# Version 0.8
+# 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')
+ x1 <- raster(raster)
+ dataType(x1) <- datatype
+
+ tmpfile1 <- ""
+ tmpfile2 <- ""
+ if (!canProcessInMemory(x1, 3)) {
+ tmpfile1 <- rasterTmpFile()
+ filename(x1) <- tmpfile1
+ if (filename == "") {
+ filename <- rasterTmpFile()
+ filename(x2) <- filename
+ if (getOption('verbose')) { cat('writing raster to:', filename(x2)) }
+ }
+ }
+
+ nc <- ncol(x1)
+ v <- vector(length=0)
+ a <- vector(length=nc)
+ a[] <- 0
+ nextclump <- 1
+ c2 <- vector(length=nc)
+ c2[] <- 0
+ rcl <- matrix(NA, nrow=0, ncol=2)
+ for (r in 1:nrow(x1)) {
+ b <- valuesRow(raster, r)
+ c1 <- c2
+ c2[] <- 0
+ if (b[1]==1) {
+ if (a[1] == 1) { c2[1] <- c1[1]
+ } else if (a[2] == 1) { c2[1] <- c1[2]
+ } else {
+ c2[1] <- nextclump
+ nextclump <- nextclump + 1
+ }
+ }
+
+ for (cc in 2:(nc)) {
+ if (b[cc]==1) {
+ if (c2[cc-1] > 0) { c2[cc] <- c2[cc-1]
+ } else if ( a[cc-1] ==1 ) {
+ c2[cc] <- c1[cc-1]
+ } else if (a[cc] == 1) {
+ c2[cc] <- c1[cc]
+ } else if (isTRUE(a[cc+1] == 1)) {
+ c2[cc] <- c1[cc+1]
+ } else {
+ c2[cc] <- nextclump
+ nextclump <- nextclump + 1
+ }
+ }
+ }
+
+ if (b[nc-1]==1) {
+ c2[nc] <- c2[nc-1]
+ } else if (b[nc]==1) {
+ if (a[nc] == 1) { c2[nc] <- c1[nc]
+ } else if (a[nc-1] == 1) { c2[nc] <- c1[nc-1]
+ } else {
+ c2[nc] <- nextclump
+ nextclump <- nextclump + 1
+ }
+ }
+ if (tmpfile1 == "") {
+ v <- c(v, c2)
+ } else {
+ x1 <- setValues(x1, c2)
+ x1 <- writeRaster(x1, r)
+ }
+# check for joining clumps:
+
+ for (cc in 1:nc) {
+ if (c2[cc] > 0) {
+ if (isTRUE(c1[cc] > 0) & isTRUE(c1[cc] != c2[cc])) {
+ rcl <- rbind(rcl, c(c2[cc], c1[cc]))
+ }
+ if (isTRUE(c1[cc-1] > 0) & isTRUE(c1[cc-1] != c2[cc])) {
+ rcl <- rbind(rcl, c(c2[cc], c1[cc-1] ))
+ }
+ if (isTRUE(c1[cc+1] > 0) & isTRUE(c1[cc+1] != c2[cc])) {
+ rcl <- rbind(rcl, c(c2[cc], c1[cc+1] ))
+ }
+ }
+ }
+
+ a <- b
+ }
+ if (tmpfile1 == "") {
+ x1 <- setValues(x1, v)
+ }
+ rcl <- unique(rbind(rcl, cbind(rcl[,2], rcl[,1])))
+ rcl <- rcl[rcl[,1] < rcl[,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]
+ aggrcl <- aggrcl[order(aggrcl[,1]), ]
+
+ rclm <- cbind(aggrcl[,1], aggrcl)
+ if (tmpfile1 == "") {
+ x1 <- reclass(x1, rclm, update=TRUE, filename=filename, datatype=datatype, overwrite=overwrite)
+ return(x1)
+ } else {
+ x2 <- reclass(x1, rclm, update=TRUE, filename=filename, datatype=datatype, overwrite=overwrite)
+ removeRasterFile(x1)
+ return(x2)
+ }
+}
+
Modified: pkg/raster/R/reclass.R
===================================================================
--- pkg/raster/R/reclass.R 2009-05-12 05:31:08 UTC (rev 450)
+++ pkg/raster/R/reclass.R 2009-05-12 07:50:38 UTC (rev 451)
@@ -4,7 +4,8 @@
# Version 0,6
# Licence GPL v3
-reclass <- function(raster, rclmat, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
+reclass <- function(raster, rclmat, update=FALSE, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
+ if (is.null(filename)) { filename <- "" }
if (class(raster) != 'RasterLayer' ) {
stop('first argument should be an object of class "RasterLayer"')
@@ -36,12 +37,22 @@
if ( dataContent(raster) == 'all' | dataContent(raster) == 'sparse') {
res <- values(raster)
- for (i in 1:length(rclmat[,1])) {
- if (is.na(rclmat[i,1]) | is.na(rclmat[i,2])) {
- res[ is.na(values(raster)) ] <- rclmat[i, 3]
- } else {
- res[ (values(raster) >= rclmat[i,1]) & (values(raster) <= rclmat[i,2]) ] <- rclmat[i , 3]
+ if (update) {
+ for (i in 1:length(rclmat[,1])) {
+ if (is.na(rclmat[i,1]) | is.na(rclmat[i,2])) {
+ res[ is.na(res) ] <- rclmat[i, 3]
+ } else {
+ res[ (res >= rclmat[i,1]) & (res <= rclmat[i,2]) ] <- rclmat[i , 3]
+ }
}
+ } else {
+ for (i in 1:length(rclmat[,1])) {
+ if (is.na(rclmat[i,1]) | is.na(rclmat[i,2])) {
+ res[ is.na(values(raster)) ] <- rclmat[i, 3]
+ } else {
+ res[ (values(raster) >= rclmat[i,1]) & (values(raster) <= rclmat[i,2]) ] <- rclmat[i , 3]
+ }
+ }
}
if ( dataContent(raster) == 'all') {
outRaster <- setValues(outRaster, res)
@@ -63,19 +74,37 @@
hasNA <- TRUE
}
}
- for (r in 1:nrow(raster)) {
- raster <- readRow(raster, r)
- res <- values(raster)
- for (i in 1:length(rclmat[,1])) {
- res[ (values(raster) >= rclmat[i,1]) & (values(raster) <= rclmat[i,2]) ] <- rclmat[i , 3]
+
+ if (update) {
+ for (r in 1:nrow(raster)) {
+ raster <- readRow(raster, r)
+ res <- values(raster)
+ for (i in 1:length(rclmat[,1])) {
+ res[ (res >= rclmat[i,1]) & (res <= rclmat[i,2]) ] <- rclmat[i,3]
+ }
+ if (hasNA) {
+ res[ is.na(res) ] <- namat[1, 3]
+ }
+ outRaster <- setValues(outRaster, res, r)
+ outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype)
}
- if (hasNA) {
- res[ is.na(values(raster)) ] <- namat[1, 3]
- }
- outRaster <- setValues(outRaster, res, r)
- outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype)
+ if (r %in% track) { .showTrack(r, outRaster at nrows, track, starttime) }
+
+ } else {
+ for (r in 1:nrow(raster)) {
+ raster <- readRow(raster, r)
+ res <- values(raster)
+ for (i in 1:length(rclmat[,1])) {
+ res[ (values(raster) >= rclmat[i,1]) & (values(raster) <= rclmat[i,2]) ] <- rclmat[i , 3]
+ }
+ if (hasNA) {
+ res[ is.na(values(raster)) ] <- namat[1, 3]
+ }
+ outRaster <- setValues(outRaster, res, r)
+ outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype)
+ }
+ if (r %in% track) { .showTrack(r, outRaster at nrows, track, starttime) }
}
- if (r %in% track) { .showTrack(r, outRaster at nrows, track, starttime) }
}
return(outRaster)
}
Added: pkg/raster/man/clump.Rd
===================================================================
--- pkg/raster/man/clump.Rd (rev 0)
+++ pkg/raster/man/clump.Rd 2009-05-12 07:50:38 UTC (rev 451)
@@ -0,0 +1,41 @@
+\name{clump}
+
+\alias{clump}
+
+\title{clump}
+
+\description{
+Calculate values for the neighborhood of clump cells
+}
+
+\usage{
+clump(raster, filename=NULL, overwrite=FALSE, filetype='raster', datatype='INT4S', track=-1)
+}
+
+\arguments{
+ \item{raster}{A RasterLayer object}
+ \item{filename}{Output filename for a new raster}
+ \item{overwrite}{Logical to indicate whether an existing output file should be overwritten}
+ \item{filetype}{output file type. Either 'raster', 'ascii' or a supported GDAL 'driver' name see \code{\link[raster]{writeRaster}}}
+ \item{datatype}{output data type; see \code{\link[raster]{dataType}}}
+ \item{track}{vector of row numbers for which the function will report that they have been processed}
+}
+
+\details{
+\code{clump} .
+}
+
+\value{
+A new RasterLayer object (in the R environment), and in some cases the side effect of a new file on disk.
+}
+
+\author{Robert J. Hijmans}
+
+\examples{
+r <- raster(ncols=25, nrows=25)
+r[] <- round(runif(ncell(r))*0.75 )
+rc <- clump(r)
+
+}
+\keyword{spatial}
+
Modified: pkg/raster/man/reclass.Rd
===================================================================
--- pkg/raster/man/reclass.Rd 2009-05-12 05:31:08 UTC (rev 450)
+++ pkg/raster/man/reclass.Rd 2009-05-12 07:50:38 UTC (rev 451)
@@ -8,12 +8,13 @@
Reclassify values of a RasterLayer
}
\usage{
-reclass(raster, rclmat, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1)
+reclass(raster, rclmat, update=FALSE, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1)
}
\arguments{
\item{raster}{A RasterLayer object}
\item{rclmat}{Matrix (or vector) for reclassifcation. (see below)}
+ \item{update}{Logical. If \code{TRUE} reclass updates previously reclassed values (see details)}
\item{filename}{Output filename for a new raster; if NA the result is not written to a file but returned with the RasterLayer object, in the data slot}
\item{overwrite}{Logical to indicate whether an existing output file should be overwritten}
\item{filetype}{output file type. Either 'raster', 'ascii' or a supported GDAL 'driver' name see \code{\link[raster]{writeRaster}}}
@@ -23,14 +24,14 @@
\details{
\code{reclass} reclassifies groups of values to other values. E.g. All values between 1 and 10 become 1, and between 11 and 15 become 2.
-Reclassification is done with matrix "rclmat". This matrix must have 3 columns.
+Reclassification is done with matrix "rclmat". This matrix must have 3 columns. (You can also supply a vector that can be coecred into a n*3 matrix)
The first two columns are "from" "to" of the input values, and the third column has the new value for that range.
-A reclass is applied to \code{from <= x <= to}, in the order that they are in the reclass table.
-You can also supply a vector that can be coecred into a n*3 matrix
-
-If the input RasterLayer object has all values in memory (e.g. after readAll(raster)), the function will also return the new values in memory. If a filename is provided, the values will also be saved to that file.
-If the values are not in memory the new values will be written to file.
+Reclassification is applied to \code{from <= x <= to}.
+Reclassification is done in the order of the reclass table. Thus there are overlapping ranges, the last range applies.
+
+If \code{update=TRUE}, reclass can update values that were re-classified according to an earlier row in the reclass table.
+For example if row 1 has \code{1, 10, 15} and row 2 has \code{11, 20, 25}, all the values from 1 to 20 will be classified as 25.
}
\value{
More information about the Raster-commits
mailing list