[Raster-commits] r110 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jan 9 17:29:15 CET 2009
Author: rhijmans
Date: 2009-01-09 17:29:15 +0100 (Fri, 09 Jan 2009)
New Revision: 110
Modified:
pkg/raster/R/map.R
pkg/raster/R/properties.R
pkg/raster/R/raster.read.R
pkg/raster/R/stack.read.R
pkg/raster/R/standard.generic.functions.R
pkg/raster/man/class.raster.Rd
pkg/raster/man/class.stack.Rd
pkg/raster/man/map.Rd
pkg/raster/man/properties.Rd
Log:
Modified: pkg/raster/R/map.R
===================================================================
--- pkg/raster/R/map.R 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/R/map.R 2009-01-09 16:29:15 UTC (rev 110)
@@ -15,7 +15,7 @@
if ( class(object) == 'RasterStack' ) {
index <- round(index)
i <- min(max(1, index), object at data@nlayers)
- if (i != index) { stop("index should be >= 1 and <= rstack at data@nlayers") }
+ if (i != index) { stop("index should be >= 1 and <=", nlayers(object), " =nlayers(stack)") }
raster2 <- object at rasters[[i]]
if (object at data@content == 'all') {
raster2 <- setValues(raster2, object at data@values[i,])
Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/R/properties.R 2009-01-09 16:29:15 UTC (rev 110)
@@ -71,6 +71,21 @@
}
}
+layers <- function(object) {
+ if (class(object) == "RasterLayer") {
+ return(filename(object))
+ } else if (class(object) == "RasterBrick") {
+ return(paste(filename(object), "with", nlayers(object), "layers"))
+ } else if (class(object) == "RasterStack") {
+ l <- vector('character')
+ for (i in 1:nlayers(object)) {
+ l <- c(l, filename(object at rasters[[i]]))
+ }
+ return(l)
+ }
+}
+
+
band <- function(object) {
if (class(object) == "RasterBrick") {
return(-1)
Modified: pkg/raster/R/raster.read.R
===================================================================
--- pkg/raster/R/raster.read.R 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/R/raster.read.R 2009-01-09 16:29:15 UTC (rev 110)
@@ -161,7 +161,11 @@
rasdim <- max(ncol(raster), nrow(raster) )
if (rasdim <= maxdim) {
- outras <- readAll(raster)
+ if (dataContent(raster) == 'all') {
+ outras <- raster
+ } else {
+ outras <- readAll(raster)
+ }
} else {
fact <- maxdim / rasdim
nc <- max(1, trunc(fact * ncol(raster)))
@@ -172,14 +176,19 @@
nr <- trunc(nrow(raster) / rowint)
cols <- 1:nc
cols <- 1 + (cols-1) * colint
- for (i in 1:nr) {
- row <- 1 + (i-1) * rowint
- raster <- readRow(raster, row)
- if (i == 1) {
- dd <- values(raster)[cols]
- } else {
+ dd <- vector()
+ if (dataContent(raster) == 'all') {
+ for (i in 1:nr) {
+ row <- 1 + (i-1) * rowint
+ v <- values(raster, row)
+ dd <- c(dd, v[cols])
+ }
+ } else {
+ for (i in 1:nr) {
+ row <- 1 + (i-1) * rowint
+ raster <- readRow(raster, row)
dd <- c(dd, values(raster)[cols])
- }
+ }
}
outras <- setRaster(raster)
outras <- setRowCol(outras, nr, nc)
@@ -196,7 +205,18 @@
}
}
+#.readrandom
+# if (length(na.omit(values(x))) > maxcell) {
+# v <- na.omit(cbind(values(x), values(y)))
+# r <- order(runif(length(v[,1])))
+# v <- v[r,]
+# l <- min(maxcell, length(v))
+# v <- v[1:l,]
+# warning(paste("plot used a sample of ", l, " cells (with data; ", maxcell, " when counting NA cells)", sep=""))
+# x <- v[,1]
+# y <- v[,2]
+
#read data on the raster for xy coordinates
.rasterReadXY <- function(raster, xy) {
if (!is.matrix(xy)) { xy <- as.matrix(t(xy)) }
Modified: pkg/raster/R/stack.read.R
===================================================================
--- pkg/raster/R/stack.read.R 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/R/stack.read.R 2009-01-09 16:29:15 UTC (rev 110)
@@ -9,7 +9,7 @@
for (i in 1:length(rstack at rasters)) {
raster <- readPartOfRow(rstack at rasters[[i]], rownumber, startcol, ncolumns)
if ( i == 1 ) {
- rstack at data@values <- values(raster)
+ rstack at data@values <- as.matrix(values(raster))
}
else {
rstack at data@values <- cbind(rstack at data@values, values(raster))
Modified: pkg/raster/R/standard.generic.functions.R
===================================================================
--- pkg/raster/R/standard.generic.functions.R 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/R/standard.generic.functions.R 2009-01-09 16:29:15 UTC (rev 110)
@@ -30,11 +30,13 @@
.getValues <- function(x) {
# need to take care of 'spase'
if (dataContent(x) != 'all') {
- if (dataSource(x) == 'ram') {
- stop('no data on disk or in memory')
+ if (class(x) == "RasterLayer") {
+ if (dataSource(x) == 'ram') {
+ stop('no data on disk or in memory')
+ } else x <- readAll(x)
} else {
x <- readAll(x)
- }
+ }
}
return(values(x))
}
@@ -46,6 +48,17 @@
return(v)
}
+.getTheValues <- function(x, y, i) {
+ if ( (class(y) == 'RasterLayer' | class(y) == 'RasterStack' | class(y) == 'RasterBrick') & compare(c(x, y)) ) {
+ return(.getValues(y))
+ } else if (is.atomic(y)) {
+ return(rep(y, ncells(x)))
+ } else if (length(y)==ncells(x)) {
+ return(y)
+ } else {
+ stop(paste("I do not understand argument",i + 1))
+ }
+}
setMethod("[", "RasterLayer",
function(x, i, j, ..., drop = TRUE) {
@@ -100,22 +113,30 @@
} else {
v <- .getValues(x)
for (i in 1:length(obs)) {
- if (class(obs[[1]]) == 'RasterLayer' & compare(c(x, obs[[1]]))) {
- v <- pmax(v, .getValues(obs[[i]]), na.rm=na.rm)
- } else if (is.atomic(obs[[1]])) {
- v <- pmax(v, rep(obs[[1]], ncells(x)), na.rm=na.rm)
- } else if (length(obs[[1]])==ncells(x)) {
- v <- pmax(v, obs[[1]], na.rm=na.rm)
- } else {
- stop(paste("I do not understand this argument:",obs[1]))
- }
+ v <- apply(cbind(v, .getTheValues(x, obs[[i]], i)), 1, max, na.rm=na.rm)
}
return(setRaster(x, values=v))
}
}
)
+setMethod("max", signature(x='RasterStack'),
+ function(x, ..., na.rm=FALSE){
+ obs <- list(...)
+ if (length(obs) == 0) {
+ return(setRaster(x, values=apply(.getValues(x), 1, max, na.rm=na.rm)))
+ } else {
+ v <- .getValues(x)
+ for (i in 1:length(obs)) {
+ v <- apply(cbind(v, .getTheValues(x, obs[[i]], i)), 1, max, na.rm=na.rm)
+ }
+ return(setRaster(x, values=v))
+ }
+ }
+)
+
+
setMethod("min", signature(x='RasterLayer'),
function(x, ..., na.rm=FALSE){
obs <- list(...)
@@ -124,15 +145,8 @@
} else {
v <- .getValues(x)
for (i in 1:length(obs)) {
- if (class(obs[[1]]) == 'RasterLayer' & compare(c(x, obs[[1]]))) {
- v <- pmin(v, .getValues(obs[[i]]), na.rm=na.rm)
- } else if (is.atomic(obs[[1]])) {
- v <- pmin(v, rep(obs[[1]], ncells(x)), na.rm=na.rm)
- } else if (length(obs[[1]])==ncells(x)) {
- v <- pmin(v, obs[[1]], na.rm=na.rm)
- } else {
- stop(paste("I do not understand this argument:",obs[1]))
- }
+ vv <- .getTheValues(x, obs[[i]], i)
+ v <- pmin(v, vv, na.rm=na.rm)
}
return(setRaster(x, values=v))
}
@@ -140,21 +154,33 @@
)
+setMethod("min", signature(x='RasterStack'),
+ function(x, ..., na.rm=FALSE){
+ obs <- list(...)
+ if (length(obs) == 0) {
+ return(setRaster(x, values=pmin(.getValues(x), na.rm)))
+ } else {
+ v <- .getValues(x)
+ for (i in 1:length(obs)) {
+ vv <- .getTheValues(x, obs[[i]], i)
+ v <- pmin(v, vv, na.rm=na.rm)
+ }
+ return(setRaster(x, values=v))
+ }
+ }
+)
+
+
+
+
.getSum <- function(obs, x, ..., na.rm=FALSE) {
v <- .getValues(x)
if (!(is.null(dim(v)))) {
v <- rowSums(.getValues(x), na.rm=na.rm)
- }
+ }
for (i in 1:length(obs)) {
- if ( (class(obs[[1]]) == 'RasterLayer' | class(obs[[1]]) == 'RasterStack' | class(obs[[1]]) == 'RasterBrick') & compare(c(x, obs[[1]])) ) {
- v <- rowSums(cbind(v, .getValues(obs[[i]]), na.rm=na.rm))
- } else if (is.atomic(obs[[1]])) {
- v <- rowSums(cbind(v, rep(obs[[1]], ncells(x)), na.rm=na.rm))
- } else if (length(obs[[1]])==ncells(x)) {
- v <- rowSums(cbind(v, obs[[1]], na.rm=na.rm))
- } else {
- stop(paste("I do not understand this argument:",obs[1]))
- }
+ vv <- .getTheValues(x, obs[[i]], i)
+ v <- rowSums(cbind(v, vv), na.rm=na.rm)
}
return(setRaster(x, values=v))
}
@@ -211,10 +237,6 @@
)
-
-
-
-
setMethod('dim', signature(x='AbstractRaster'),
function(x){ return(c(nrow(x), ncol(x)))}
)
@@ -273,13 +295,17 @@
setMethod("plot", signature(x='RasterStack', y='numeric'),
function(x, y, ...) {
- ind <- as.integer(round(y))
- ind <- min(max(ind, 1), nlayers(x))
- map(x, ind, ...)
+ map(x, y, ...)
}
)
+setMethod("plot", signature(x='RasterStack', y='missing'),
+ function(x, ...) {
+ map(x, 1, ...)
+ }
+)
+
setMethod("plot", signature(x='RasterBrick', y='numeric'),
function(x, y, ...) {
ind <- as.integer(round(y))
@@ -290,39 +316,29 @@
+.getmaxdim <- function(maxdim=1000, ...) {
+ return(maxdim)
+}
+
+.getcex <- function(cex = 0.1, ...) {
+ return(cex)
+}
+
setMethod("plot", signature(x='RasterLayer', y='RasterLayer'),
function(x, y, ...) {
comp <- compare(c(x, y), origin=FALSE, resolution=FALSE, rowcol=TRUE, projection=FALSE, slack=0, stopiffalse=TRUE)
- if (dataContent(x) != 'all') {
- if (ncells(x) > 15000) {
- maxdim <- 200
- } else {
- maxdim <- 10000
- }
- x <- readSkip(x, maxdim=maxdim)
- if (x != y) {
- warning(paste('plot used a sample of ', round(100*ncells(x)/ncells(y)), "% of the cells", sep=""))
- }
- y <- readSkip(y, maxdim=maxdim)
- x <- values(x)
- y <- values(y)
- plot(x, y, cex=0.1, ...)
- } else {
- maxcell <- 15000
- if (length(na.omit(values(x))) > maxcell) {
- v <- na.omit(cbind(values(x), values(y)))
- r <- order(runif(length(v[,1])))
- v <- v[r,]
- l <- min(maxcell, length(v))
- v <- v[1:l,]
- warning(paste("plot used a sample of ", l, " cells (with data; ", maxcell, " when counting NA cells)", sep=""))
- x <- v[,1]
- y <- v[,2]
- plot(x, y, cex=0.1, ...)
- }
+ maxdim <- .getmaxdim(...)
+ nc <- ncells(x)
+ x <- readSkip(x, maxdim=maxdim)
+ y <- readSkip(y, maxdim=maxdim)
+ rm(maxdim)
+ if (length(x) < nc) {
+ warning(paste('plot used a sample of ', round(100*length(x)/ncells(y)), "% of the cells", sep=""))
}
+ cex <- .getcex(...)
+ plot(x, y, ...)
}
-)
+)
setMethod('hist', signature(x='RasterLayer'),
@@ -350,3 +366,5 @@
}
)
+
+
Modified: pkg/raster/man/class.raster.Rd
===================================================================
--- pkg/raster/man/class.raster.Rd 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/man/class.raster.Rd 2009-01-09 16:29:15 UTC (rev 110)
@@ -1,9 +1,7 @@
\name{RasterLayer-class}
\docType{class}
\alias{RasterLayer-class}
-\alias{plot}
-\alias{plot,RasterLayer,missing-method}
-\alias{plot,RasterLayer,RasterLayer-method}
+
\alias{summary}
\alias{summary,AbstractRaster-method}
\alias{show,RasterLayer-method}
@@ -19,8 +17,10 @@
\alias{sum,RasterLayer-method}
\alias{sum,RasterStack-method}
\alias{sum,RasterBrick-method}
+\alias{max,RasterLayer-method}
+\alias{max,RasterStack-method}
\alias{min,RasterLayer-method}
-\alias{max,RasterLayer-method}
+\alias{min,RasterStack-method}
\alias{range,RasterLayer-method}
\alias{[,RasterLayer-method}
@@ -29,6 +29,7 @@
\usage{
hist(x, ...)
+
}
\arguments{
Modified: pkg/raster/man/class.stack.Rd
===================================================================
--- pkg/raster/man/class.stack.Rd 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/man/class.stack.Rd 2009-01-09 16:29:15 UTC (rev 110)
@@ -2,7 +2,6 @@
\docType{class}
\alias{RasterStack-class}
\alias{show,RasterStack-method}
-\alias{plot,RasterStack,numeric-method}
\title{Class "RasterStack" }
\description{ Class for handling "Stacks" of rasters. }
Modified: pkg/raster/man/map.Rd
===================================================================
--- pkg/raster/man/map.Rd 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/man/map.Rd 2009-01-09 16:29:15 UTC (rev 110)
@@ -1,5 +1,11 @@
\name{map}
\alias{map}
+\alias{plot}
+\alias{plot,RasterLayer,missing-method}
+\alias{plot,RasterLayer,RasterLayer-method}
+\alias{plot,RasterStack,numeric-method}
+\alias{plot,RasterStack,missing-method}
+
\title{ Map a raster layer }
\description{
Make a map of a RasterLayer
Modified: pkg/raster/man/properties.Rd
===================================================================
--- pkg/raster/man/properties.Rd 2009-01-09 09:34:23 UTC (rev 109)
+++ pkg/raster/man/properties.Rd 2009-01-09 16:29:15 UTC (rev 110)
@@ -16,6 +16,7 @@
\alias{boundingbox}
\alias{origin}
\alias{nlayers}
+\alias{layers}
\alias{band}
\alias{nbands}
@@ -43,6 +44,7 @@
boundingbox(object)
origin(object)
nlayers(object)
+layers(object)
band(object)
nbands(object)
}
More information about the Raster-commits
mailing list