[Raster-commits] r426 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 23 11:15:18 CEST 2009
Author: rhijmans
Date: 2009-04-23 11:15:18 +0200 (Thu, 23 Apr 2009)
New Revision: 426
Added:
pkg/raster/R/cellStats2.R
pkg/raster/R/count.R
pkg/raster/R/freq.R
pkg/raster/R/removeRasterFile.R
pkg/raster/man/count.Rd
pkg/raster/man/freq.Rd
Removed:
pkg/raster/R/filenames.R
Modified:
pkg/raster/R/cellStats.R
pkg/raster/R/click.R
pkg/raster/R/copyRaster.R
pkg/raster/R/depracated.R
pkg/raster/R/zonal.R
pkg/raster/man/cellStats.Rd
pkg/raster/man/copyRasterFile.Rd
pkg/raster/man/zonal.Rd
Log:
Modified: pkg/raster/R/cellStats.R
===================================================================
--- pkg/raster/R/cellStats.R 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/R/cellStats.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -4,13 +4,11 @@
# Version 0.8
# Licence GPL v3
-cellStats <- function(x, ..., na.rm=TRUE) {
+.Old.cellStats <- function(x, ..., na.rm=TRUE) {
funs <- list(...)
if (length(funs) == 0) {
stop('you must provide a function as argument')
}
-
-
res <- list()
if (dataContent(x) != 'all') {
if (dataSource(x) == 'ram') {
Added: pkg/raster/R/cellStats2.R
===================================================================
--- pkg/raster/R/cellStats2.R (rev 0)
+++ pkg/raster/R/cellStats2.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -0,0 +1,52 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : March 2009
+# Version 0.8
+# Licence GPL v3
+
+cellStats <- function(raster, stat='mean', track=-1) {
+
+ if (class(stat) != 'character') {
+ if (canProcessInMemory(raster, 2)) {
+ if (dataContent(raster) != 'all') {
+ raster <- readAll(raster)
+ }
+ d <- na.omit(values(raster))
+ return( stat(d) )
+ } else {
+ stop("RasterLayer is too large. You can use fun='sum', 'mean', 'min', or 'max', but not a function")
+ }
+ } else {
+
+ counts <- FALSE
+ if (stat == 'sum') {
+ fun <- sum
+ } else if (stat == 'min') {
+ fun <- min
+ } else if (stat == 'max') {
+ fun <- max
+ } else if (stat == 'mean') {
+ fun <- sum
+ counts <- TRUE
+ } else {
+ stop("invalid 'stat', should be 'sum', 'min', 'max', or 'mean'")
+ }
+
+ cnt <- vector(length=0)
+ st <- vector(length=0)
+ starttime <- proc.time()
+ for (r in 1:nrow(raster)) {
+ d <- na.omit(valuesRow(raster, r))
+ st <- fun(d, st)
+ if (counts) {
+ cnt <- cnt + length(d)
+ }
+ if (r %in% track) { .showTrack(r, raster at nrows, track, starttime) }
+ }
+ if (counts) {
+ st <- st / cnt
+ }
+ return(st)
+ }
+}
+
Modified: pkg/raster/R/click.R
===================================================================
--- pkg/raster/R/click.R 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/R/click.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -16,11 +16,7 @@
return(cbind(xyCoords))
}
if (dataContent(object) != 'all') {
- #if (dataSource(object) != 'disk') {
- # stop('no data associated with this RasterLayer object')
- #} else {
value <- xyValues(object, xyCoords)
- #}
} else {
cell <- cellFromXY(object, xyCoords)
if (class(object) == 'RasterStack') {
@@ -29,9 +25,18 @@
value <- values(object)[cell]
}
}
- if (xy) {
- return(cbind(xyCoords, value))
+ value <- t(matrix(value))
+ if (class(object) == 'RasterStack') {
+ colnames(value) <- layerNames(object)
} else {
- return(value)
+ colnames(value) <- 'value'
}
+
+ if (xy) {
+ value <- cbind(xyCoords, value)
+ colnames(value)[1] <- 'x'
+ colnames(value)[2] <- 'y'
+ }
+ return(t(value))
+
}
Modified: pkg/raster/R/copyRaster.R
===================================================================
--- pkg/raster/R/copyRaster.R 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/R/copyRaster.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -45,49 +45,3 @@
}
-
-removeFile <- function(raster) {
- raster <- closeConnection(raster)
- fname <- filename(raster)
- fileext <- toupper(ext(fname))
- if (fileext == ".GRD") {
- fgrd <- fname
- ext(fgrd) <- '.grd'
- fgri <- fname
- ext(fgri) <- '.gri'
- if (!file.exists(fgrd) | !file.exists(fgri)) {
- stop('file does not exist')
- }
- res <- file.remove(fgrd)
- if (!res) { stop('could not remove grd file') }
- res <- file.remove(fgri)
- if (!res) { stop('could not remove gri file') }
- } else {
- stop('only implemented for raster format files')
- }
- filename(raster) <- ''
- return(raster)
-}
-
-
-
-removeRasterFile <- function(filename) {
- fname <- trim(filename)
- fileext <- toupper(ext(fname))
- if (fileext == ".GRD") {
- fgrd <- fname
- ext(fgrd) <- '.grd'
- fgri <- fname
- ext(fgri) <- '.gri'
- if (!file.exists(fgrd) | !file.exists(fgri)) {
- stop('file does not exist')
- }
- res <- file.remove(fgrd)
- if (!res) { stop('could not remove grd file') }
- res <- file.remove(fgri)
- if (!res) { stop('could not remove gri file') }
- } else {
- stop('only implemented for raster format files')
- }
-}
-
Added: pkg/raster/R/count.R
===================================================================
--- pkg/raster/R/count.R (rev 0)
+++ pkg/raster/R/count.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -0,0 +1,33 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : March 2009
+# Version 0.8
+# Licence GPL v3
+
+
+count <- function(raster, value, digits=0) {
+ if (canProcessInMemory(raster, 2)) {
+ if (dataContent(raster) != 'all') {
+ raster <- readAll(raster)
+ }
+ if (is.na(value)) {
+ x <- sum(is.na(values(raster)))
+ } else {
+ v <- na.omit(round(values(raster), digits=digits))
+ x <- sum(v == value)
+ }
+ } else {
+ x <- 0
+ for (r in 1:nrow(raster)) {
+ raster <- readRow(raster, r)
+ if (is.na(value)) {
+ x <- x + sum(is.na(values(raster)))
+ } else {
+ v <- na.omit(round(values(raster), digits=digits))
+ x <- x + sum(v == value)
+ }
+ }
+ }
+ return(x)
+}
+
Modified: pkg/raster/R/depracated.R
===================================================================
--- pkg/raster/R/depracated.R 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/R/depracated.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -5,10 +5,31 @@
rasterFromFile <- function(filename, values=FALSE, band=1) {
- stop("'rasterFromFile' is deprecated. Use 'raster(filename)' instead")
+ stop("'rasterFromFile' has been removed. Use 'raster(filename)' instead")
}
+..shortFileName <- function(filename) {
+# is this the same as basename ?
+ filename <- gsub("\\\\", "/", filename)
+ if (filename == "") {return(filename)
+ } else {
+ split <- strsplit(filename, "/")
+ l <- length(split[[1]])
+ shortfilename <- split[[1]][[l]]
+ return(shortfilename)
+ }
+}
+
+..path <- function(filename) {
+# use dirname instead
+ filename <- gsub("\\\\", "/", filename)
+ file <- ..shortFileName(filename)
+ path <- gsub(file, '', filename)
+ return(path)
+}
+
+
...isNA <- function(raster, value=0, filename="", overwrite=FALSE, asInt=FALSE) {
fun <- function(x) { x[is.na(x)] <- value; return(x)}
if (asInt) { datatype <- 'INT4S' } else { datatype <- 'FLT4S' }
Deleted: pkg/raster/R/filenames.R
===================================================================
--- pkg/raster/R/filenames.R 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/R/filenames.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -1,29 +0,0 @@
-# R miscellaneouse file name related functions
-# Authors: Robert J. Hijmans
-# International Rice Research Institute
-# contact: r.hijmans at gmail.com
-# Date : October 2008
-# Version 0.8
-# Licence GPL v3
-
-# no longer used
-
-.shortFileName <- function(filename) {
-# is this the same as basename ?
- filename <- gsub("\\\\", "/", filename)
- if (filename == "") {return(filename)
- } else {
- split <- strsplit(filename, "/")
- l <- length(split[[1]])
- shortfilename <- split[[1]][[l]]
- return(shortfilename)
- }
-}
-
-.path <- function(filename) {
-# use dirname instead
- filename <- gsub("\\\\", "/", filename)
- file <- .shortFileName(filename)
- path <- gsub(file, '', filename)
- return(path)
-}
Added: pkg/raster/R/freq.R
===================================================================
--- pkg/raster/R/freq.R (rev 0)
+++ pkg/raster/R/freq.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -0,0 +1,29 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : March 2009
+# Version 0.8
+# Licence GPL v3
+
+freq <- function(raster, digits=0) {
+ if (canProcessInMemory(raster, 2)) {
+ if (dataContent(raster) != 'all') {
+ raster <- readAll(raster)
+ }
+ d <- round(values(raster), digits=digits)
+ x <- table(d, useNA="ifany" )
+ } else {
+ xx <- vector(length=0)
+ for (r in 1:nrow(raster)) {
+ raster <- readRow(raster, r)
+ d <- round(values(raster), digits=digits)
+ x <- table(d, useNA="ifany" )
+ x <- cbind(as.numeric(unlist(as.vector(dimnames(x)))), as.vector(x))
+ xx <- rbind(xx, x)
+ }
+ x <- tapply(xx[,2], xx[,1], sum)
+ }
+ x <- cbind(as.numeric(unlist(as.vector(dimnames(x)))), as.vector(x))
+ colnames(x) <- c('value', 'count')
+ return(x)
+}
+
Added: pkg/raster/R/removeRasterFile.R
===================================================================
--- pkg/raster/R/removeRasterFile.R (rev 0)
+++ pkg/raster/R/removeRasterFile.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -0,0 +1,38 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : February 2009
+# Version 0.8
+# Licence GPL v3
+
+
+removeRasterFile <- function(raster) {
+ if (class(raster) == 'RasterLayer') {
+ fname <- filename(raster)
+# to do: need to close the connection in the object in the Global environement
+ raster <- closeConnection(raster)
+ filename(raster) <- ''
+ } else {
+ fname <- trim(raster)
+ }
+ fileext <- toupper(ext(fname))
+ if (fileext == ".GRD") {
+ fgrd <- fname
+ ext(fgrd) <- '.grd'
+ fgri <- fname
+ ext(fgri) <- '.gri'
+ if (!file.exists(fgrd) | !file.exists(fgri)) {
+ stop('file does not exist')
+ }
+ res <- file.remove(fgrd)
+ if (!res) { stop('could not remove grd file') }
+ res <- file.remove(fgri)
+ if (!res) { stop('could not remove gri file') }
+ } else {
+ stop('only implemented for raster format files')
+ }
+ if (class(raster) == 'RasterLayer') {
+ return(raster)
+ } else {
+ return('OK')
+ }
+}
Modified: pkg/raster/R/zonal.R
===================================================================
--- pkg/raster/R/zonal.R 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/R/zonal.R 2009-04-23 09:15:18 UTC (rev 426)
@@ -8,9 +8,15 @@
if (class(stat) != 'character') {
if (canProcessInMemory(raster, 3)) {
- d <- values(readAll(raster))
+ if (dataContent(raster) != 'all') {
+ raster <- readAll(raster)
+ }
+ d <- values(raster)
rm(raster)
- d <- cbind(d, as.integer(values(readAll(zones))))
+ if (dataContent(zones) != 'all') {
+ zones <- readAll(zones)
+ }
+ d <- cbind(d, as.integer(values(zones)))
rm(zones)
if (keepdata) {
d <- na.omit(d)
@@ -18,7 +24,7 @@
alltab <- tapply(d[,1], d[,2], stat)
stat <- deparse(substitute(stat))
} else {
- stop("RasterLayers are too large. You an use fun='sum', 'mean', 'min', or 'max', but not a function")
+ stop("RasterLayers are too large. You can use fun='sum', 'mean', 'min', or 'max', but not a function")
}
} else {
Modified: pkg/raster/man/cellStats.Rd
===================================================================
--- pkg/raster/man/cellStats.Rd 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/man/cellStats.Rd 2009-04-23 09:15:18 UTC (rev 426)
@@ -11,24 +11,21 @@
}
\usage{
-cellStats(x, ..., na.rm=TRUE)
+cellStats(raster, stat='mean', track=-1)
}
\arguments{
- \item{x}{A vector of numbers (typically integers for mode)}
- \item{...}{one or more applicable functions}
- \item{na.rm}{Remove (ignore) NA values}
+ \item{raster}{A RasterLayer}
+ \item{stat}{The function to be applied. Either as character: 'mean', 'min', 'max', 'sum'; or a function (see Details) }
+ \item{track}{vector of row numbers for which the function will report that they have been processed}
}
\value{
- depends on the function(s) passed as ... argument. Typically a numeric value.
+ A numeric value.
}
\details{
-valid functions are those that take a numeric vector as argument, and return a single value.
-For example: \code{min}, \code{max}, \code{mean}
-
-This function does not work for very large raster datasets (as all the data need to be loaded into memory).
+If \code{stat} is a \code{function}, \code{zonal} will fail (gracefully) for very large RasterLayers
}
\seealso{ \code{\link[raster]{setMinMax} } }
@@ -38,7 +35,10 @@
\examples{
r <- raster(nrow=18, ncol=36)
r[] <- runif(ncell(r)) * 10
-cellStats(r, min, max)
+# works for large files
+cellStats(r, 'mean')
+# does not work for very large files
+cellStats(r, mean)
}
\keyword{univar}
Modified: pkg/raster/man/copyRasterFile.Rd
===================================================================
--- pkg/raster/man/copyRasterFile.Rd 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/man/copyRasterFile.Rd 2009-04-23 09:15:18 UTC (rev 426)
@@ -3,24 +3,22 @@
\alias{moveRasterFile}
\alias{copyRasterFile}
\alias{removeRasterFile}
-\alias{removeFile}
\title{move or copy a raster file}
\description{
-Move, copy or remove 'raster' format files. removeRaster removes the files on disk that are associated with the RasterLayer object.
+Move, copy or remove 'raster' format files that are associated with the RasterLayer object.
}
\usage{
moveRasterFile(raster, filename, overwrite=FALSE)
copyRasterFile(raster, filename, overwrite=FALSE)
-removeRasterFile(filename)
-removeFile(raster)
+removeRasterFile(raster)
}
\arguments{
\item{raster}{RasterLayer object that is associated with a file on disk}
-\item{filename}{Output filename}
+\item{filename}{New filename}
\item{overwrite}{Logical. If \code{TRUE} existing files are overwritten}
}
@@ -28,6 +26,10 @@
a RasterLayer
}
+\details{
+\code{removeRasterFile} can also take a filename as argument in stead of a RasterLayer.
+}
+
\author{Robert J. Hijmans}
\seealso{ \code{\link[raster]{saveAs}} }
Added: pkg/raster/man/count.Rd
===================================================================
--- pkg/raster/man/count.Rd (rev 0)
+++ pkg/raster/man/count.Rd 2009-04-23 09:15:18 UTC (rev 426)
@@ -0,0 +1,36 @@
+\name{count}
+
+\alias{count}
+
+\title{Count}
+
+\description{
+Count the frequency of a single value in a RasterLayer.
+}
+
+\usage{
+count(raster, value, digits=0)
+}
+
+\arguments{
+ \item{raster}{A RasterLayer}
+ \item{value}{The value to be counted}
+ \item{digits}{the number of digits for rounding the values}
+}
+
+\value{
+numeric
+}
+
+\seealso{ \code{\link[raster]{setMinMax} } }
+
+\author{Robert J. Hijmans}
+
+\examples{
+r <- raster(nrow=18, ncol=36)
+r[] <- runif(ncell(r))
+r <- r * r * r * 10
+count(r, 5)
+}
+
+\keyword{univar}
Added: pkg/raster/man/freq.Rd
===================================================================
--- pkg/raster/man/freq.Rd (rev 0)
+++ pkg/raster/man/freq.Rd 2009-04-23 09:15:18 UTC (rev 426)
@@ -0,0 +1,36 @@
+\name{freq}
+
+\alias{freq}
+
+\title{Frequency table}
+
+\description{
+Frequncy table of the values of a RasterLayer.
+}
+
+\usage{
+freq(raster, digits=0)
+}
+
+\arguments{
+ \item{raster}{A RasterLayer}
+ \item{digits}{the number of digits for rounding the values}
+}
+
+\value{
+ A matrix
+}
+
+
+\seealso{ \code{\link[raster]{setMinMax} } }
+
+\author{Robert J. Hijmans}
+
+\examples{
+r <- raster(nrow=18, ncol=36)
+r[] <- runif(ncell(r))
+r <- r * r * r * 10
+freq(r)
+}
+
+\keyword{univar}
Modified: pkg/raster/man/zonal.Rd
===================================================================
--- pkg/raster/man/zonal.Rd 2009-04-22 14:49:08 UTC (rev 425)
+++ pkg/raster/man/zonal.Rd 2009-04-23 09:15:18 UTC (rev 426)
@@ -21,7 +21,7 @@
}
\details{
-If \code{stat} is a \code{function}, \code{zonal} will fail for very large RasterLayers
+If \code{stat} is a \code{function}, \code{zonal} will fail (gracefully) for very large RasterLayers
}
\value{
More information about the Raster-commits
mailing list