[Raster-commits] r306 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Mar 4 04:32:46 CET 2009
Author: rhijmans
Date: 2009-03-04 04:32:46 +0100 (Wed, 04 Mar 2009)
New Revision: 306
Added:
pkg/raster/R/addToStack.R
pkg/raster/R/dropLayer.R
pkg/raster/R/inifile.R
pkg/raster/R/mean.R
pkg/raster/R/na.R
pkg/raster/R/stackFile.R
pkg/raster/R/summarize.R
pkg/raster/R/unstack.R
pkg/raster/man/summarize.Rd
pkg/raster/man/unstack.Rd
Removed:
pkg/raster/R/read.inifile.R
pkg/raster/R/summary.methods.R
pkg/raster/man/classes.Rd
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/compare.logical.functions.R
pkg/raster/R/read.raster.R
pkg/raster/R/stack.R
pkg/raster/R/summary.R
pkg/raster/R/values.R
pkg/raster/man/RasterLayer-class.Rd
pkg/raster/man/Summary-methods.Rd
pkg/raster/man/create.stack.Rd
pkg/raster/man/plot-methods.Rd
pkg/raster/man/properties.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/DESCRIPTION 2009-03-04 03:32:46 UTC (rev 306)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.8-10
-Date: 3-March-2009
+Version: 0.8.9-1
+Date: 4-March-2009
Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
Author: Robert J. Hijmans & Jacob van Etten
Maintainer: Robert J. Hijmans <r.hijmans at gmail.com>
Added: pkg/raster/R/addToStack.R
===================================================================
--- pkg/raster/R/addToStack.R (rev 0)
+++ pkg/raster/R/addToStack.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,105 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+addFiles <- function(rstack, rasterfiles, bands=rep(1, length(rasterfiles))) {
+ if (length(bands) == 1) {
+ bands=rep(bands, length(rasterfiles))
+ }
+ rasters <- list()
+ for (i in 1:length(rasterfiles)) {
+ if (bands[[i]] < 1) {
+ r <- rasterFromFile(rasterfiles[[i]], band=1)
+ rasters <- c(rasters, r)
+ if (nbands(r) > 1) {
+ for (j in 2:nbands(r)) {
+ r <- rasterFromFile(rasterfiles[[i]], band=j)
+ rasters <- c(rasters, r)
+ }
+ }
+ } else {
+ rasters <- c(rasters, rasterFromFile(rasterfiles[[i]], FALSE, band=bands[[i]]))
+ }
+ }
+ rstack <- addRasters(rstack, rasters)
+ return(rstack)
+}
+
+
+
+addRasters <- function(rstack, rasters) {
+#rasters is a list of raster objects
+ if (class(rstack) != "RasterStack") {
+ stop("rstack should be a RasterStack object")
+ }
+ if (length(rasters) == 1 & class(rasters) == 'RasterLayer') {
+ rasters <- list(rasters)
+ }
+
+ for (i in 1 : length(rasters)) {
+ raster <- rasters[[i]]
+ if (dataContent(raster) != 'all' & dataSource(raster) == 'ram') {
+ stop("Cannot add a memory based RasterLayer object without values to a Rasterstack object")
+ }
+ nl <- rstack at data@nlayers + 1
+ rstack at data@nlayers <- as.integer(nl)
+ if (nlayers(rstack) == 1) {
+ rstack <- setRowCol(rstack, nrow(raster), ncol(raster))
+ rstack <- setBbox(rstack, raster, snap=FALSE)
+ rstack <- setProjection(rstack, projection(raster))
+ if (trim(raster at file@shortname) != "") {
+ cname <- trim(raster at file@shortname)
+ } else {
+ cname <- "layer1"
+ }
+ rstack at data@colnames[1] <- cname
+ if (dataContent(raster) == 'all') {
+ rstack at data@values <- as.matrix(values(raster))
+ rstack at data@content <- 'all'
+ raster <- clearValues(raster)
+ } else {
+ if (dataSource(raster) == 'ram' & dataContent(raster) != "all") {
+ stop("Cannot add a memory based RasterLayer object without values to a Rasterstack object")
+ }
+ }
+ } else {
+ if (!compare(c(rstack, raster))) {
+ stop(paste("could not add raster:", filename(raster)))
+ }
+ count <- 1
+ cname <- trim(raster at file@shortname)
+ if (cname == "") {
+ cname <- paste("layer", nl, sep="")
+ }
+ cn <- cname
+ for (j in 1:(nl-1)) {
+ if ( cn == rstack at data@colnames[j] ) {
+ count <- count + 1
+ cn <- paste(cname, "_", count, sep="")
+ }
+ }
+ rstack at data@colnames[nl] <- cn
+ if (dataContent(rstack)=='all') {
+ if (dataContent(raster) != 'all') {
+ raster <- readAll(raster)
+ }
+ rstack at data@values <- cbind(rstack at data@values, values(raster))
+ raster <- clearValues(raster)
+ } else {
+ if (dataSource(raster)=='disk') {
+ raster <- clearValues(raster)
+ }
+ }
+ }
+ rstack at layers[nl] <- raster
+ rstack at data@min[nl] <- raster at data@min
+ rstack at data@max[nl] <- raster at data@max
+ }
+ return(rstack)
+}
+
+
Modified: pkg/raster/R/compare.logical.functions.R
===================================================================
--- pkg/raster/R/compare.logical.functions.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/compare.logical.functions.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -8,16 +8,14 @@
.getLogicalRowValues <- function(x, r) {
# need to take care of 'spase'
v <- .getRowValues(x, r)
- v[v<0] <- 0
- v[v>0] <- 1
+ v[v!=0] <- 1
return(v)
}
.getLogicalValues <- function(x) {
v <- .getRasterValues(x)
- v[v<0] <- 0
- v[v>0] <- 1
+ v[v!=0] <- 1
return(v)
}
@@ -44,7 +42,7 @@
setMethod('!', signature(x='RasterLayer'),
function(x){
- if (.CanProcessInMemory(x, 1)) {
+ if (.CanProcessInMemory(x, 2)) {
return(setValues(x, !values(x)))
} else {
raster <- setRaster(x, filename=tempfile())
@@ -65,7 +63,7 @@
if (!isTRUE(is.atomic(e2) & length(e2)==1)) {
stop('second argument should be a single number')
}
- if (.CanProcessInMemory(e1, 2)) {
+ if (.CanProcessInMemory(e1, 3)) {
raster <- setRaster(e1)
raster <- setDatatype(raster, datatype='LOGICAL')
raster <- setValues(raster, values=callGeneric(.getRasterValues(e1), rep(e2, ncell(e1)) ) )
@@ -89,7 +87,7 @@
if (!isTRUE(is.atomic(e1) & length(e1)==1)) {
stop('first argument should be a single number')
}
- if (.CanProcessInMemory(e2, 2)) {
+ if (.CanProcessInMemory(e2, 3)) {
raster <- setRaster(e2)
raster <- setDatatype(raster, 'LOGICAL')
raster <- setValues(raster, callGeneric(.getRasterValues(e2), rep(e1, ncell(e2)) ) )
@@ -112,7 +110,7 @@
if (!cond) {
stop("Cannot compare RasterLayers that have different BasicRaster attributes. See compare()")
}
- if (.CanProcessInMemory(e1, 2)) {
+ if (.CanProcessInMemory(e1, 3)) {
raster <- setRaster(e1)
raster <- setDatatype(raster, 'LOGICAL')
raster <- setValues(raster, callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) )
@@ -135,7 +133,7 @@
setMethod("Logic", signature(e1='RasterLayer', e2='RasterLayer'),
function(e1, e2){
if ( compare(c(e1, e2)) ) {
- if (.CanProcessInMemory(e1, 2)) {
+ if (.CanProcessInMemory(e1, 3)) {
raster <- setRaster(e1)
raster <- setDatatype(raster, 'LOGICAL')
raster <- setValues(raster, callGeneric(.getLogicalValues(e1), .getLogicalValues(e2)))
@@ -153,36 +151,3 @@
)
-
-setMethod("is.na", signature(x='RasterLayer'),
- function(x) {
- raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
- return(setValues(raster, is.na(.getRasterValues(x))))
- }
-)
-
-setMethod("is.nan", signature(x='RasterLayer'),
- function(x) {
- raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
- return(setValues(raster, is.nan(.getRasterValues(x))))
- }
-)
-
-setMethod("is.infinite", signature(x='RasterLayer'),
- function(x) {
- raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
- return(setValues(raster, values=is.infinite(.getRasterValues(x))))
- }
-)
-
-setMethod("is.finite", signature(x='RasterLayer'),
- function(x) {
- raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
- return(setValues(raster, values=is.finite(.getRasterValues(x))))
- }
-)
-
Added: pkg/raster/R/dropLayer.R
===================================================================
--- pkg/raster/R/dropLayer.R (rev 0)
+++ pkg/raster/R/dropLayer.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,21 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+dropLayer <- function(rstack, indices) {
+ indices <- sort(indices, decreasing=TRUE)
+ for (i in 1:length(indices)) {
+ index <- -1 * indices[i]
+ rstack at layers <- rstack at layers[index]
+ rstack at data@nlayers <- as.integer(rstack at data@nlayers - 1)
+ if (dataContent(rstack) == 'all') {
+ rstack at data@values <- rstack at data@values[,index, drop=FALSE]
+ }
+ }
+ return(rstack)
+}
+
Added: pkg/raster/R/inifile.R
===================================================================
--- pkg/raster/R/inifile.R (rev 0)
+++ pkg/raster/R/inifile.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,57 @@
+# Authors: Robert J. Hijmans
+# International Rice Research Institute
+# contact: r.hijmans at gmail.com
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+# Read inifile into a matrix of 'section', 'name', value'
+# this function allows for using inistrings that have "=" in the value
+# e.g. "projection = +proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"
+
+
+readIniFile <- function(filename) {
+
+ strSplitOnFirstToken <- function(s, token="=") {
+ pos <- which(strsplit(s, '')[[1]]==token)[1]
+ if (is.na(pos)) {
+ return(c(trim(s), NA))
+ } else {
+ first <- substr(s, 1, (pos-1))
+ second <- substr(s, (pos+1), nchar(s))
+ return(trim(c(first, second)))
+ }
+ }
+
+ strsplitcomment <- function(s) {
+ # ";" is the start of a comment .
+ strSplitOnFirstToken(s, token=";")
+ }
+
+
+ if (!file.exists(filename)) { stop(paste(filename, " does not exist")) }
+
+ Lines <- readLines(filename, warn = FALSE)
+
+ ini <- lapply(Lines, strsplitcomment)
+
+ Lines <- matrix(unlist(ini), ncol=2, byrow=T)[,1]
+ ini <- lapply(Lines, strSplitOnFirstToken)
+
+ ini <- matrix(unlist(ini), ncol=2, byrow=T)
+ ini <- subset(ini, ini[,1] != "")
+
+ sections <- c(which(is.na(ini[,2])), length(ini[,2]))
+# here I should check whether the section text is enclused in [ ]. If not, it is junk text that should be removed, rather than used as a section
+ ini <- cbind("", ini)
+ for (i in 1:(length(sections)-1)) {
+ ini[sections[i]:(sections[i+1]), 1] <- ini[sections[i],2]
+ }
+ ini[,1] <- gsub("\\[", "", ini[,1])
+ ini[,1] <- gsub("\\]", "", ini[,1])
+
+ colnames(ini) <- c("section", "name", "value")
+ sections <- sections[1:(length(sections)-1)]
+ return(ini[-sections,])
+}
+
Added: pkg/raster/R/mean.R
===================================================================
--- pkg/raster/R/mean.R (rev 0)
+++ pkg/raster/R/mean.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,41 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : March 2009
+# Version 0.8
+# Licence GPL v3
+
+
+
+
+setMethod("mean", signature(x='Raster'),
+ function(x, ..., na.rm=FALSE){
+
+ rasters <- list(...)
+ if (length(rasters)==0) { return(x) }
+
+ for (i in 1:length(rasters)) {
+ if (class(rasters[[i]]) == 'RasterStack') {
+ r <- rasters[[i]]
+ rasters <- rasters[-i]
+ rasters <- c(rasters, unstack(r))
+ rm(r)
+ }
+ }
+ rasters <- c(x, rasters)
+ rm(x)
+
+ return( .summaryRasters(rasters, mean, 'mean', na.rm=na.rm) )
+ }
+)
+
+
+setMethod("mean", signature(x='RasterStack'),
+ function(x, ..., na.rm=FALSE){
+
+ x1 <- asRasterLayer(x, 1)
+ x <- dropLayer(x, 1)
+
+ return( mean(x1, x, ..., na.rm=na.rm) )
+ }
+)
+
Added: pkg/raster/R/na.R
===================================================================
--- pkg/raster/R/na.R (rev 0)
+++ pkg/raster/R/na.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,39 @@
+# Authors: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+setMethod("is.na", signature(x='RasterLayer'),
+ function(x) {
+ raster <- setRaster(x)
+ raster <- setDatatype(raster, 'LOGICAL')
+ return(setValues(raster, is.na(.getRasterValues(x))))
+ }
+)
+
+setMethod("is.nan", signature(x='RasterLayer'),
+ function(x) {
+ raster <- setRaster(x)
+ raster <- setDatatype(raster, 'LOGICAL')
+ return(setValues(raster, is.nan(.getRasterValues(x))))
+ }
+)
+
+setMethod("is.infinite", signature(x='RasterLayer'),
+ function(x) {
+ raster <- setRaster(x)
+ raster <- setDatatype(raster, 'LOGICAL')
+ return(setValues(raster, values=is.infinite(.getRasterValues(x))))
+ }
+)
+
+setMethod("is.finite", signature(x='RasterLayer'),
+ function(x) {
+ raster <- setRaster(x)
+ raster <- setDatatype(raster, 'LOGICAL')
+ return(setValues(raster, values=is.finite(.getRasterValues(x))))
+ }
+)
+
Deleted: pkg/raster/R/read.inifile.R
===================================================================
--- pkg/raster/R/read.inifile.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/read.inifile.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -1,50 +0,0 @@
-# Authors: Robert J. Hijmans
-# International Rice Research Institute
-# contact: r.hijmans at gmail.com
-# Date : October 2008
-# Version 0,2
-# Licence GPL v3
-
-# Read inifile into a matrix of 'section', 'name', value'
-# this function allows for using inistrings that have "=" in the value
-# e.g. "projection = +proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"
-
-
-.strSplitOnFirstToken <- function(s, token="=") {
- pos <- which(strsplit(s, '')[[1]]==token)[1]
- if (is.na(pos)) {
- return(c(trim(s), NA))
- } else {
- first <- substr(s, 1, (pos-1))
- second <- substr(s, (pos+1), nchar(s))
- return(trim(c(first, second)))
- }
-}
-
-
-readIniFile <- function(filename) {
- if (!file.exists(filename)) { stop(paste(filename, " does not exist")) }
-
- Lines <- readLines(filename, warn = FALSE)
-# ";" is the start of a comment .
- strsplitcomment <- function(s) {.strSplitOnFirstToken(s, token=";")}
- ini <- lapply(Lines, strsplitcomment)
- Lines <- matrix(unlist(ini), ncol=2, byrow=T)[,1]
- ini <- lapply(Lines, .strSplitOnFirstToken)
- ini <- matrix(unlist(ini), ncol=2, byrow=T)
- ini <- subset(ini, ini[,1] != "")
-
- sections <- c(which(is.na(ini[,2])), length(ini[,2]))
-# here I should check whether the section text is enclused in [ ]. If not, it is junk text that should be removed, rather than used as a section
- ini <- cbind("", ini)
- for (i in 1:(length(sections)-1)) {
- ini[sections[i]:(sections[i+1]), 1] <- ini[sections[i],2]
- }
- ini[,1] <- gsub("\\[", "", ini[,1])
- ini[,1] <- gsub("\\]", "", ini[,1])
-
- colnames(ini) <- c("section", "name", "value")
- sections <- sections[1:(length(sections)-1)]
- return(ini[-sections,])
-}
-
Modified: pkg/raster/R/read.raster.R
===================================================================
--- pkg/raster/R/read.raster.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/read.raster.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -211,15 +211,20 @@
.stackRead <- function(rstack, rownumber, startcol=1, ncolumns=(ncol(rstack)-startcol+1)) {
+ if (dataSource(rstack) == 'ram') {
+ if (rownumber > 0) {
+ warning('all values are in memory; no point in using read')
+ }
+ return(rstack)
+ }
+ rstack at data@values <- matrix(nrow=length(values(raster)), ncol=nlayers(rstack))
+
for (i in seq(nlayers(rstack))) {
raster <- .rasterRead(rstack at layers[[i]], rownumber, startcol, ncolumns)
- if ( i == 1 ) {
- rstack at data@values <- matrix(nrow=length(values(raster)), ncol=nlayers(rstack))
- rstack at data@content <- dataContent(raster)
- rstack at data@indices <- dataIndices(raster)
- }
rstack at data@values[,i] <- values(raster)
}
+ rstack at data@content <- dataContent(raster)
+ rstack at data@indices <- dataIndices(raster)
return(rstack)
}
Modified: pkg/raster/R/stack.R
===================================================================
--- pkg/raster/R/stack.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/stack.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -4,34 +4,8 @@
# Version 0.8
# Licence GPL v3
-stackOpen <- function(stackfile) {
- st <- read.table(stackfile, as.is=FALSE, strip.white=TRUE)
- if (dim(st)[2] > 1) {
- rst <- stackFromFiles(st[,1], st[,2])
- } else {
- rst <- stackFromFiles(st[,1])
- }
- rst <- setFilename(rst, stackfile)
- return(rst)
-}
-stackSave <- function(rstack) {
- stackfile <- trim(rstack at filename)
- if (stackfile == "") { stop('RasterStack does not have a filename.') }
- thefile <- file(stackfile, "w")
- for (i in 1:length(rstack at layers)) {
- fname <- trim(filename(rstack at layers[[i]]))
- if (trim(fname) == "") {
- stop("cannot save a RasterStack that has Layers without filenames. Use writeStack instead.")
- }
- cat(fname, "\t", band(rstack at layers[[i]]),"\n", file=thefile)
- }
- close(thefile)
- return(rstack)
-}
-
-
stackFromFiles <- function(rasterfiles, bands= rep(1, length(rasterfiles))) {
# stop("this function is depracated. Use makeStack() instead.")
rstack <- new("RasterStack")
@@ -40,7 +14,6 @@
-
if (!isGeneric("stack")) {
setGeneric("stack", function(x, ...)
standardGeneric("stack"))
@@ -75,112 +48,3 @@
} )
-
-addFiles <- function(rstack, rasterfiles, bands=rep(1, length(rasterfiles))) {
- if (length(bands) == 1) {
- bands=rep(bands, length(rasterfiles))
- }
- rasters <- list()
- for (i in 1:length(rasterfiles)) {
- if (bands[[i]] < 1) {
- r <- rasterFromFile(rasterfiles[[i]], band=1)
- rasters <- c(rasters, r)
- if (nbands(r) > 1) {
- for (j in 2:nbands(r)) {
- r <- rasterFromFile(rasterfiles[[i]], band=j)
- rasters <- c(rasters, r)
- }
- }
- } else {
- rasters <- c(rasters, rasterFromFile(rasterfiles[[i]], FALSE, band=bands[[i]]))
- }
- }
- rstack <- addRasters(rstack, rasters)
- return(rstack)
-}
-
-
-
-addRasters <- function(rstack, rasters) {
-#rasters is a list of raster objects
- if (class(rstack) != "RasterStack") {
- stop("rstack should be a RasterStack object")
- }
- if (length(rasters) == 1 & class(rasters) == 'RasterLayer') {
- rasters <- list(rasters)
- }
-
- for (i in 1 : length(rasters)) {
- raster <- rasters[[i]]
- if (dataContent(raster) != 'all' & dataSource(raster) == 'ram') {
- stop("Cannot add a memory based RasterLayer object without values to a Rasterstack object")
- }
- nl <- rstack at data@nlayers + 1
- rstack at data@nlayers <- as.integer(nl)
- if (nlayers(rstack) == 1) {
- rstack <- setRowCol(rstack, nrow(raster), ncol(raster))
- rstack <- setBbox(rstack, raster, snap=FALSE)
- rstack <- setProjection(rstack, projection(raster))
- if (trim(raster at file@shortname) != "") {
- cname <- trim(raster at file@shortname)
- } else {
- cname <- "layer1"
- }
- rstack at data@colnames[1] <- cname
- if (dataContent(raster) == 'all') {
- rstack at data@values <- as.matrix(values(raster))
- rstack at data@content <- 'all'
- raster <- clearValues(raster)
- } else {
- if (dataSource(raster) == 'ram' & dataContent(raster) != "all") {
- stop("Cannot add a memory based RasterLayer object without values to a Rasterstack object")
- }
- }
- } else {
- if (!compare(c(rstack, raster))) {
- stop(paste("could not add raster:", filename(raster)))
- }
- count <- 1
- cname <- trim(raster at file@shortname)
- if (cname == "") {
- cname <- paste("layer", nl, sep="")
- }
- cn <- cname
- for (j in 1:(nl-1)) {
- if ( cn == rstack at data@colnames[j] ) {
- count <- count + 1
- cn <- paste(cname, "_", count, sep="")
- }
- }
- rstack at data@colnames[nl] <- cn
- if (dataContent(rstack)=='all') {
- if (dataContent(raster) != 'all') {
- raster <- readAll(raster)
- }
- rstack at data@values <- cbind(rstack at data@values, values(raster))
- raster <- clearValues(raster)
- } else {
- if (dataSource(raster)=='disk') {
- raster <- clearValues(raster)
- }
- }
- }
- rstack at layers[nl] <- raster
- rstack at data@min[nl] <- raster at data@min
- rstack at data@max[nl] <- raster at data@max
- }
- return(rstack)
-}
-
-
-dropLayer <- function(rstack, indices) {
- indices <- sort(indices, decreasing=TRUE)
- for (i in 1:length(indices)) {
- index <- -1 * indices[i]
- rstack at layers <- rstack at layers[index]
- rstack at data@nlayers <- as.integer(rstack at data@nlayers - 1)
- }
- return(rstack)
-}
-
-
Added: pkg/raster/R/stackFile.R
===================================================================
--- pkg/raster/R/stackFile.R (rev 0)
+++ pkg/raster/R/stackFile.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,34 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+stackOpen <- function(stackfile) {
+ st <- read.table(stackfile, as.is=FALSE, strip.white=TRUE)
+ if (dim(st)[2] > 1) {
+ rst <- stackFromFiles(st[,1], st[,2])
+ } else {
+ rst <- stackFromFiles(st[,1])
+ }
+ rst <- setFilename(rst, stackfile)
+ return(rst)
+}
+
+stackSave <- function(rstack) {
+ stackfile <- trim(rstack at filename)
+ if (stackfile == "") { stop('RasterStack does not have a filename.') }
+ thefile <- file(stackfile, "w")
+ for (i in 1:length(rstack at layers)) {
+ fname <- trim(filename(rstack at layers[[i]]))
+ if (trim(fname) == "") {
+ stop("cannot save a RasterStack that has Layers without filenames. Use writeStack instead.")
+ }
+ cat(fname, "\t", band(rstack at layers[[i]]),"\n", file=thefile)
+ }
+ close(thefile)
+ return(rstack)
+}
+
Added: pkg/raster/R/summarize.R
===================================================================
--- pkg/raster/R/summarize.R (rev 0)
+++ pkg/raster/R/summarize.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,61 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,8
+# Licence GPL v3
+
+
+
+setMethod('summary', signature(object='RasterStack'),
+ function(object, ...) {
+ if (dataContent(object) == 'all') {
+ for (n in 1:nlayers(object)) {
+ cat("layer ", n, "\n")
+ cat("NAs : ", sum(is.na(values(object)[,n])), "\n")
+ summary(values(object)[,n])
+ }
+ } else {
+ cat("values not in memory\n")
+ }
+ }
+)
+
+
+
+setClass('RasterLayerSummary',
+ representation (
+ ncell = 'numeric',
+ dataContent = 'character',
+ NAs = 'numeric',
+ values = 'matrix'
+ )
+)
+
+setMethod('show', signature(object='RasterLayerSummary'),
+ function(object) {
+ cat ("Cells: " , object at ncell, "\n")
+ if ( object at dataContent == "all") {
+ cat("NAs : ", object at NAs, "\n")
+ cat("\nValues")
+ tab <- as.table(object at values)
+ colnames(tab) <- ""
+ print(tab)
+ } else {
+ cat("values not in memory\n")
+ }
+ }
+)
+
+setMethod('summary', signature(object='RasterLayer'),
+ function(object, ...) {
+ sumobj <- new("RasterLayerSummary")
+ sumobj at ncell <- ncell(object)
+ sumobj at dataContent <- dataContent(object)
+ if ( sumobj at dataContent == "all") {
+ sumobj at NAs <- sum(is.na(values(object)))
+ sumobj at values <- as.matrix( summary(values(object)) )
+ }
+ return(sumobj)
+ }
+)
+
Modified: pkg/raster/R/summary.R
===================================================================
--- pkg/raster/R/summary.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/summary.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -1,61 +1,91 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# Authors: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
-# Date : June 2008
-# Version 0,8
+# Date : January 2009
+# Version 0.8
# Licence GPL v3
+.summaryRasters <- function(rasters, fun, funname, na.rm) {
-setMethod('summary', signature(object='RasterStack'),
- function(object, ...) {
- if (dataContent(object) == 'all') {
- for (n in 1:nlayers(object)) {
- cat("layer ", n, "\n")
- cat("NAs : ", sum(is.na(values(object)[,n])), "\n")
- summary(values(object)[,n])
+ if (!.CanProcessInMemory(rasters[[1]], 2)) {
+ filename <- tempfile()
+ raster <- setRaster(rasters[[1]], filename)
+ } else {
+ filename <- ""
+ raster <- setRaster(rasters[[1]])
+ v <- vector(length=0)
+ }
+
+ m <- matrix(NA, nrow=ncol(rasters[[1]]), ncol=length(rasters))
+ for (r in 1:nrow(rasters[[1]])) {
+ m[] <- NA
+ for (i in 1:length(rasters)) {
+ if (is.atomic(rasters[[i]])) {
+ m[,i] <- rasters[[i]]
+ } else {
+ m[,i] <- .getRowValues(rasters[[i]], r)
}
+ }
+ if (funname == 'any' || funname == 'all') {
+ m[m != 0] <- 1
+ }
+
+ vv <- apply(m, 1, fun, na.rm=na.rm)
+
+ if (funname == 'range') {
+ vv <- vv[2,] - vv[1,]
+ }
+
+ if (filename == "") {
+ v <- c(v, vv)
} else {
- cat("values not in memory\n")
+ raster <- setValues(raster, vv, r)
+ raster <- writeRaster(raster)
}
}
-)
+ if (filename == "") {
+ raster <- setValues(raster, v)
+ }
+ return(raster)
+}
-setClass('RasterLayerSummary',
- representation (
- ncell = 'numeric',
- dataContent = 'character',
- NAs = 'numeric',
- values = 'matrix'
- )
-)
-
-setMethod('show', signature(object='RasterLayerSummary'),
- function(object) {
- cat ("Cells: " , object at ncell, "\n")
- if ( object at dataContent == "all") {
- cat("NAs : ", object at NAs, "\n")
- cat("\nValues")
- tab <- as.table(object at values)
- colnames(tab) <- ""
- print(tab)
- } else {
- cat("values not in memory\n")
+setMethod("Summary", signature(x='RasterLayer'),
+ function(x, ..., na.rm=FALSE){
+
+ rasters <- list(...)
+ if (length(rasters)==0) { return(x) }
+
+ for (i in 1:length(rasters)) {
+ if (class(rasters[[i]]) == 'RasterStack') {
+ r <- rasters[[i]]
+ rasters <- rasters[-i]
+ rasters <- c(rasters, unstack(r))
+ rm(r)
+ }
}
- }
+ rasters <- c(x, rasters)
+ rm(x)
+
+ fun <- sys.call(sys.parent())[[1]]
+ funname <- as.character(sys.call(sys.parent())[[1]])
+
+ return( .summaryRasters(rasters, fun, funname, na.rm) )
+ }
)
-setMethod('summary', signature(object='RasterLayer'),
- function(object, ...) {
- sumobj <- new("RasterLayerSummary")
- sumobj at ncell <- ncell(object)
- sumobj at dataContent <- dataContent(object)
- if ( sumobj at dataContent == "all") {
- sumobj at NAs <- sum(is.na(values(object)))
- sumobj at values <- as.matrix( summary(values(object)) )
- }
- return(sumobj)
- }
+
+
+setMethod("Summary", signature(x='RasterStack'),
+ function(x, ..., na.rm=FALSE){
+
+ x1 <- asRasterLayer(x, 1)
+ x <- dropLayer(x, 1)
+
+ return( callGeneric(x1, x, ..., na.rm=na.rm))
+ }
)
+
+
Deleted: pkg/raster/R/summary.methods.R
===================================================================
--- pkg/raster/R/summary.methods.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/summary.methods.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -1,133 +0,0 @@
-# Authors: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : January 2009
-# Version 0.8
-# Licence GPL v3
-
-
-
-setMethod("max", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- # this is for a RasterStack
- return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, max, na.rm=na.rm)))
- } else {
- v <- .getRasterValues(x)
- for (i in 1:length(obs)) {
- v <- apply(cbind(v, .getAllTypeOfValues(x, obs[[i]], i)), 1, max, na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-setMethod("min", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, min, na.rm=na.rm)))
- } else {
- v <- .getRasterValues(x)
- for (i in 1:length(obs)) {
- v <- apply(cbind(v, .getAllTypeOfValues(x, obs[[i]], i)), 1, min, na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-setMethod("sum", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=rowSums(as.matrix(.getRasterValues(x)), na.rm)))
- } else {
- v <- .getRasterValues(x)
- if (!(is.null(dim(v)))) {
- v <- rowSums(as.matrix(.getRasterValues(x)), na.rm=na.rm)
- }
- for (i in 1:length(obs)) {
- vv <- .getAllTypeOfValues(x, obs[[i]], i)
- v <- rowSums(cbind(v, vv), na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-#todo "any", "all"
-
-
-setMethod("mean", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- obs <- list(...)
- if (length(obs) == 0) {
- return(setRaster(x, values=rowMeans(as.matrix(.getRasterValues(x)), na.rm)))
- } else {
- v <- .getRasterValues(x)
- if (!(is.null(dim(v)))) {
- v <- rowMeans(as.matrix(.getRasterValues(x)), na.rm=na.rm)
- }
- for (i in 1:length(obs)) {
- vv <- .getAllTypeOfValues(x, obs[[i]], i)
- v <- rowMeans(cbind(v, vv), na.rm=na.rm)
- }
- return(setRaster(x, values=v))
- }
- }
-)
-
-
-
-
-setMethod("range", signature(x='Raster'),
- function(x, ..., na.rm=FALSE){
- return(max(x, ..., na.rm=na.rm) - min(x, ..., na.rm=na.rm))
- }
-)
-
-
-
-#if (!isGeneric("median")) {
-# setGeneric("median", function(x, na.rm=FALSE)
-# standardGeneric("median"))
-#}
-
-
-#setMethod('median', signature(x='Raster'),
-# function(x, na.rm=FALSE){
-# if (dataContent(x) == 'all') {
-# return(median(values(x), na.rm=na.rm))
-# } else {
-# needs to be improved for large files. Make frequency table row by row.....
-# return(median(values(readAll(x)), na.rm=na.rm))
-# }
-# }
-#)
-
-
-#if (!isGeneric("rmedian")) {
-# setGeneric("rmedian", function(x, ..., na.rm=FALSE)
-# standardGeneric("rmedian"))
-#}
-
-#setMethod('rmedian', signature(x='Raster'),
-# function(x, ..., na.rm=FALSE){
-# obs <- list(...)
-# if (length(obs) == 0) {
-# return(setRaster(x, values=apply(as.matrix(.getRasterValues(x)), 1, median, na.rm=na.rm)))
-# } else {
-# stk <- stack(c(x,obs))
-# v <- vector()
-# for (r in 1:nrow(stk)) {
-# v <- c(v, apply(values(readRow(stk, r)), 1, median, na.rm=na.rm))
-# }
-# return(setRaster(x, values=v))
-# }
-# }
-#)
-
Added: pkg/raster/R/unstack.R
===================================================================
--- pkg/raster/R/unstack.R (rev 0)
+++ pkg/raster/R/unstack.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -0,0 +1,23 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : March 2009
+# Version 0.8
+# Licence GPL v3
+
+
+
+if (!isGeneric("unstack")) {
+ setGeneric("unstack", function(x, ...)
+ standardGeneric("unstack"))
+}
+
+setMethod("unstack", signature(x='RasterStack'),
+function(x) {
+ rlist <- list()
+ for (i in nlayers(x):1) {
+ rlist[i] <- asRasterLayer(x, i)
+ x <- dropLayer(x, i)
+ }
+ return(rlist)
+} )
+
Modified: pkg/raster/R/values.R
===================================================================
--- pkg/raster/R/values.R 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/R/values.R 2009-03-04 03:32:46 UTC (rev 306)
@@ -89,11 +89,19 @@
}
startcell <- ((rownr - firstrow) * ncol(raster) + 1)
endcell <- startcell + ncol(raster) - 1
- return(values(raster)[startcell:endcell])
+ if (class(raster) == 'RasterStack') {
+ return(values(raster)[startcell:endcell,])
+ } else {
+ return(values(raster)[startcell:endcell])
+ }
} else if (dataContent(raster) == 'all'){
startcell <- cellFromRowCol(raster, rownr, 1)
endcell <- startcell+ncol(raster)-1
- return(values(raster)[startcell:endcell])
+ if (class(raster) == 'RasterStack') {
+ return(values(raster)[startcell:endcell,])
+ } else {
+ return(values(raster)[startcell:endcell])
+ }
} else {
stop('something is wrong with the RasterLayer dataContent')
}
Modified: pkg/raster/man/RasterLayer-class.Rd
===================================================================
--- pkg/raster/man/RasterLayer-class.Rd 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/man/RasterLayer-class.Rd 2009-03-04 03:32:46 UTC (rev 306)
@@ -9,7 +9,9 @@
\alias{show,BasicRaster-method}
\alias{show,RasterLayer-method}
+\alias{show,RasterStack-method}
+
\title{ Raster* classes}
Modified: pkg/raster/man/Summary-methods.Rd
===================================================================
--- pkg/raster/man/Summary-methods.Rd 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/man/Summary-methods.Rd 2009-03-04 03:32:46 UTC (rev 306)
@@ -1,30 +1,42 @@
-\name{Summary-methods}
+\name{Summary}
\docType{methods}
-\alias{sum,Raster-method}
-\alias{max,Raster-method}
-\alias{min,Raster-method}
-\alias{range,Raster-method}
+\alias{Summary-methods}
+\alias{Summary,RasterLayer-method}
+\alias{Summary,RasterStack-method}
\alias{mean,Raster-method}
+\alias{mean,RasterStack-method}
-\title{ Summary methods for Raster* objects }
+\title{ Summary methods }
+
\description{
- The following methods have been implemented: sum, max, min, range and mean
+ The following summary methods are available for Raster* objects:
+ \code{mean, max, min, range, prod, sum, any, all}
+}
+
+
+
+\note{
+ These methods compare layers and the result of these methods is always a single RasterLayer.
+ The generic functin \code{range} returns 2 values (the minimum and maximum value of a vector). The Raster* implementations returns a single values (the range)
- These methods compare layers and the result of these methods is always a single RasterLayer.
For the extreme values within in a layer use maxValue() and minValue()
}
+\value{a RasterLayer}
\author{Robert J. Hijmans }
\examples{
-r1 <- raster()
+r1 <- raster(nrow=10, ncol=10)
r1 <- setValues(r1, runif(ncell(r1)))
-r2 <- 2 * r1 * r1
-r3 <- sqrt(r1) * 5
-r4 <- max(r1, r2, r3)
+r2 <- setValues(r1, runif(ncell(r1)))
+r3 <- setValues(r1, runif(ncell(r1)))
+r <- max(r1, r2, r3)
+r <- range(r1, r2, r3)
+s <- stack(r1, r2, r3)
+r <- mean(s)
}
\keyword{methods}
-\keyword{math}
+\keyword{spatial}
Deleted: pkg/raster/man/classes.Rd
===================================================================
--- pkg/raster/man/classes.Rd 2009-03-03 10:07:38 UTC (rev 305)
+++ pkg/raster/man/classes.Rd 2009-03-04 03:32:46 UTC (rev 306)
@@ -1,51 +0,0 @@
-\name{classes}
-\docType{class}
-
-\alias{show,RasterStack-method}
-\alias{hist,Raster-method}
-\alias{dim,BasicRaster-method}
-\alias{summary,RasterLayer-method}
-\alias{show,RasterLayerSummary-method}
-\alias{summary,RasterStack-method}
-
-\title{Replace methods }
-\description{
- to be moved ....
- }
-
-
-\arguments{
- \item{x}{ AbstractRaster object }
- \item{raster}{ RasterLayer object }
- \item{...}{ additional arguments for the generic functions }
-}
-
-
-\section{Objects from the Class}{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 306
More information about the Raster-commits
mailing list