[Raster-commits] r429 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Apr 24 08:40:59 CEST 2009
Author: rhijmans
Date: 2009-04-24 08:40:58 +0200 (Fri, 24 Apr 2009)
New Revision: 429
Added:
pkg/raster/R/dataType.R
pkg/raster/R/image.R
pkg/raster/R/persp.R
pkg/raster/R/resolution.R
pkg/raster/man/dataType.Rd
pkg/raster/man/image.Rd
pkg/raster/man/persp.Rd
Removed:
pkg/raster/R/setDatatype.R
pkg/raster/man/setDatatype.Rd
pkg/raster/man/setRowCol.Rd
Modified:
pkg/raster/NAMESPACE
pkg/raster/R/aggold.R
pkg/raster/R/aggregate.R
pkg/raster/R/cellStats.R
pkg/raster/R/coercion.R
pkg/raster/R/compare.R
pkg/raster/R/contour.R
pkg/raster/R/disaggregate.R
pkg/raster/R/expand.R
pkg/raster/R/map.R
pkg/raster/R/plot.R
pkg/raster/R/polygonToRaster.R
pkg/raster/R/rasterFromCells.R
pkg/raster/R/readSkip.R
pkg/raster/R/replaceProperties.R
pkg/raster/R/setRowCol.R
pkg/raster/R/stackAdd.R
pkg/raster/R/writeAscii.R
pkg/raster/R/xyProperties.R
pkg/raster/R/zonal.R
pkg/raster/man/cellStats.Rd
pkg/raster/man/compare.Rd
pkg/raster/man/contour.Rd
pkg/raster/man/dimensions.Rd
pkg/raster/man/filename.Rd
pkg/raster/man/merge.Rd
pkg/raster/man/plot.Rd
pkg/raster/man/project.Rd
pkg/raster/man/resolution.Rd
Log:
Modified: pkg/raster/NAMESPACE
===================================================================
--- pkg/raster/NAMESPACE 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/NAMESPACE 2009-04-24 06:40:58 UTC (rev 429)
@@ -1,8 +1,8 @@
importFrom("methods", Ops, Math)
-importFrom("graphics", hist, plot, lines, contour)
+importFrom("graphics", hist, plot, lines, image, contour, persp)
importFrom("stats", aggregate)
importFrom("utils", stack, unstack)
importFrom("sp", overlay, bbox, Spatial, SpatialPixels, SpatialPixelsDataFrame, SpatialGrid, SpatialGridDataFrame)
exportClasses(BoundingBox, BasicRaster, Raster, RasterLayer, RasterStack)
-exportMethods(raster, calc, overlay, bbox, aggregate, stack, unstack, show, summary, plot, hist, contour, ncol, nrow, ncell, dim, Median)
-exportPattern("^[^\\.]")
\ No newline at end of file
+exportMethods(raster, calc, overlay, bbox, aggregate, stack, unstack, show, summary, plot, hist, contour, persp, ncol, nrow, ncell, dim, Median)
+exportPattern("^[^\\.]")
Modified: pkg/raster/R/aggold.R
===================================================================
--- pkg/raster/R/aggold.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/aggold.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -40,7 +40,7 @@
dataType(outRaster) <- datatype
bndbox <- newBbox(xmin(x), xmx, ymn, ymax(x))
outRaster <- setExtent(outRaster, bndbox, keepres=FALSE)
- outRaster <- setRowCol(outRaster, nrows=rsteps, ncols=csteps)
+ rowcol(outRaster) <- c(rsteps, csteps)
if (na.rm) {
Modified: pkg/raster/R/aggregate.R
===================================================================
--- pkg/raster/R/aggregate.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/aggregate.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -53,7 +53,7 @@
dataType(outRaster) <- datatype
bndbox <- newBbox(xmin(x), xmx, ymn, ymax(x))
outRaster <- setExtent(outRaster, bndbox, keepres=FALSE)
- outRaster <- setRowCol(outRaster, nrows=rsteps, ncols=csteps)
+ rowcol(outRaster) <- c(rsteps, csteps)
addcol <- 0
addrow <- 0
Modified: pkg/raster/R/cellStats.R
===================================================================
--- pkg/raster/R/cellStats.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/cellStats.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -37,6 +37,7 @@
st <- NULL
starttime <- proc.time()
for (r in 1:nrow(raster)) {
+ if (r %in% track) { .showTrack(r, raster at nrows, track, starttime) }
d <- na.omit(valuesRow(raster, r))
if (length(d) == 0) { next }
if (stat == 'sd') {
@@ -49,9 +50,6 @@
} else {
st <- fun(c(d, st))
}
- if (r %in% track) {
- .showTrack(r, raster at nrows, track, starttime)
- }
}
if (stat == 'sd') {
meansq <- (st/cnt)^2
@@ -63,3 +61,5 @@
}
}
+
+
Modified: pkg/raster/R/coercion.R
===================================================================
--- pkg/raster/R/coercion.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/coercion.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -11,7 +11,7 @@
.asSpGrid <- function(object, type='grid', dataframe=TRUE) {
bb <- .toSpBbox(object)
- cs <- resolution(object)
+ cs <- res(object)
cc <- bb[,1] + (cs/2)
cd <- ceiling(diff(t(bb))/cs)
grd <- GridTopology(cellcentre.offset=cc, cellsize=cs, cells.dim=cd)
@@ -120,7 +120,7 @@
} else {
rs <- new("RasterLayer")
rs <- setExtent(rs, extent(x))
- rs <- setRowCol(rs, nrow(x), ncol(x))
+ rowcol(rs) <- c(nrow(x), ncol(x))
}
return(rs)
}
@@ -133,7 +133,7 @@
r <- raster()
r <- setExtent(r, extent(x))
projection(r) <- x at proj4string
- r <- setRowCol(r, x at grid@cells.dim[2], x at grid@cells.dim[1])
+ rowcol(r) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
dindex <- max(1, min(dim(x at data)[2], index))
if (dindex != index) { warning(paste("index was changed to", dindex))}
# to become an option, but currently support for sparse is too ..... sparse
@@ -159,7 +159,7 @@
r <- raster()
r <- setExtent(r, extent(x))
projection(r) <- x at proj4string
- r <- setRowCol(r, x at grid@cells.dim[2], x at grid@cells.dim[1])
+ rowcol(r) <- c(x at grid@cells.dim[2], x at grid@cells.dim[1])
dindex <- max(1, min(dim(x at data)[2], index))
if (dindex != index) { warning(paste("index was changed to", dindex))}
r <- setValues(r, x at data[[dindex]])
@@ -174,7 +174,7 @@
stk <- new("RasterStack")
stk <- setExtent(stk, extent(spgrid))
projection(stk) <- spgrid at proj4string
- stk <- setRowCol(stk, spgrid at grid@cells.dim[2], spgrid at grid@cells.dim[1])
+ rowcol(stk) <- c(spgrid at grid@cells.dim[2], spgrid at grid@cells.dim[1])
if (class(spgrid)=='SpatialPixelsDataFrame') {
spgrid <- as(spgrid, 'SpatialGridDataFrame')
Modified: pkg/raster/R/compare.R
===================================================================
--- pkg/raster/R/compare.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/compare.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -14,7 +14,7 @@
result <- F
stop('The first argument should consist of at least 2 Raster* objects')
}
- minres <- min(resolution(objects[[1]]))
+ minres <- min(res(objects[[1]]))
for (i in 2:length(objects)) {
if (bb) {
if (!(isTRUE(all.equal(extent(objects[[1]]), extent(objects[[i]]), tolerance=tolerance, scale=minres )))) {
@@ -44,7 +44,7 @@
}
# Can also check res through bb & rowcol
if (res) {
- if (!(isTRUE(all.equal(resolution(objects[[1]]), resolution(objects[[i]]), tolerance=tolerance, scale=minres)))) {
+ if (!(isTRUE(all.equal(res(objects[[1]]), res(objects[[i]]), tolerance=tolerance, scale=minres)))) {
result <- F
if (stopiffalse) { stop('different resolution') }
if (showwarning) { warning('different resolution') }
Modified: pkg/raster/R/contour.R
===================================================================
--- pkg/raster/R/contour.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/contour.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -4,9 +4,13 @@
# Version 0.8
# Licence GPL v3
+if (!isGeneric("contour")) {
+ setGeneric("contour", function(x,...)
+ standardGeneric("contour"))
+}
setMethod("contour", signature(x='RasterLayer'),
- function(x, maxdim=1000, add=TRUE, ...) {
+ function(x, maxdim=1000, ...) {
if (dataContent(x) != 'all') {
# to do: should test if can read, else sample
if (canProcessInMemory(x, 2)) {
@@ -15,7 +19,16 @@
x <- sampleSkip(x, maxdim, asRaster=TRUE)
}
}
- contour(x=xFromCol(x,1:ncol(x)), y=yFromRow(x, nrow(x):1), z=t((values(x, format='matrix'))[nrow(x):1,]), add=add, ...)
+ contour(x=xFromCol(x,1:ncol(x)), y=yFromRow(x, nrow(x):1), z=t((values(x, format='matrix'))[nrow(x):1,]), ...)
}
)
+
+setMethod("contour", signature(x='RasterStack'),
+ function(x, y=1, maxdim=1000, ...) {
+ if (y < 1) { y <- 1 }
+ if (y > nlayers(x)) { y <- nlayers(x) }
+ contour(x=x, y=y, maxdim=maxdim, ...)
+ }
+)
+
Added: pkg/raster/R/dataType.R
===================================================================
--- pkg/raster/R/dataType.R (rev 0)
+++ pkg/raster/R/dataType.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -0,0 +1,107 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+'dataType<-' <- function(x, value) {
+# for backward compatibility issues and non fatal mistakes.
+ datatype <- substr( toupper( trim(value) ), 1, 5)
+ if (datatype=='LOGIC') {datatype <- 'LOG1S'}
+ if (datatype == 'INTEG') {datatype <- 'INT4S'}
+ if (datatype == 'NUMER') {datatype <- 'FLT4S'}
+ if (datatype == 'FLOAT') {datatype <- 'FLT4S'}
+ if (datatype == 'DOUBL') {datatype <- 'FLT8S'}
+ if (datatype == 'SINGL') {datatype <- 'FLT4S'}
+ if (datatype == 'REAL') {datatype <- 'FLT4S'}
+
+ if (nchar(datatype) < 3) {
+ stop(paste('invalid datatype:', datatype))
+ } else if (nchar(datatype) == 3) {
+ if (datatype == 'LOG') {
+ datatype <- paste(datatype, '1S', sep='')
+ } else {
+ datatype <- paste(datatype, '4S', sep='')
+ }
+ } else if (nchar(datatype) == 4) {
+ if (datatype == 'INT1') {
+ datatype <- paste(datatype, 'U', sep='')
+ } else {
+ datatype <- paste(datatype, 'S', sep='')
+ }
+ }
+
+# now for real
+
+ if (!(substr(datatype, 1, 4) %in% c('LOG1', 'INT1', 'INT2', 'INT4', 'INT8', 'INT1', 'INT2', 'INT4', 'INT8', 'FLT4', 'FLT8'))) {
+ stop('not a valid data type')
+ }
+ type <- substr(datatype,1,3)
+ size <- substr(datatype,4,4)
+ signed <- substr(datatype,1,3) != 'U'
+
+ if (type == "FLT") {
+ if (dataContent(x) != 'nodata') {
+ x at data@values <- as.numeric(values(x))
+ }
+ if (size == '4') {
+ x at file@datanotation <- 'FLT4S'
+ x at file@nodatavalue <- -3.4E38
+ } else if (size == '8') {
+ x at file@datanotation <- 'FLT8S'
+ x at file@nodatavalue <- -1.7E308
+ } else {
+ stop("invalid datasize for a FLT (should be 4 or 8)")
+ }
+ } else if (type == "INT") {
+ x at data@min <- round(minValue(x))
+ x at data@max <- round(maxValue(x))
+ if (dataContent(x) != 'nodata') {
+ x at data@values <- as.integer(round(values(x)))
+ }
+ if (size == '4') {
+ if (signed) {
+ x at file@datanotation <- 'INT4S'
+ x at file@nodatavalue <- -2147483647
+ } else {
+ x at file@datanotation <- 'INT4U'
+ x at file@nodatavalue <- 4294967295
+ }
+ } else if (size == '2') {
+ if (signed) {
+ x at file@datanotation <- 'INT2S'
+ x at file@nodatavalue <- -32768
+ } else {
+ x at file@datanotation <- 'INT2U'
+ x at file@nodatavalue <- 65535
+ }
+ } else if (size == '1') {
+ # there is no nodata value for byte
+ x at file@nodatavalue <- -9999
+ if (signed) {
+ x at file@datanotation <- 'INT1S'
+ } else {
+ x at file@datanotation <- 'INT1U'
+ }
+ warning("binary files of a single byte do not have NA values on disk")
+ } else if (size == '8') {
+ if (signed) {
+ x at file@nodatavalue <- -9223372036854775808
+ x at file@datanotation <- 'INT8S'
+ } else {
+ x at file@nodatavalue <- 18446744073709551615
+ x at file@datanotation <- 'INT8U'
+ }
+ } else {
+ stop("invalid datasize for this datatype")
+ }
+ } else if ( type == 'LOG' ) {
+ x at file@nodatavalue <- -127
+ x at file@datanotation <- 'LOG1S'
+ } else {
+ stop("unknown datatype")
+ }
+ return(x)
+}
+
Modified: pkg/raster/R/disaggregate.R
===================================================================
--- pkg/raster/R/disaggregate.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/disaggregate.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -22,8 +22,8 @@
outraster <- raster(raster, filename)
dataType(outraster) <- datatype
- outraster <- setRowCol(outraster, nrow(raster) * yfact, ncol(raster) * xfact)
-
+ rowcol(outraster) <- c(nrow(raster) * yfact, ncol(raster) * xfact)
+
if ( dataContent(raster)=='all') {
cols <- rep(rep(1:ncol(raster), each=xfact), times=nrow(raster)*yfact)
Modified: pkg/raster/R/expand.R
===================================================================
--- pkg/raster/R/expand.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/expand.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -11,7 +11,7 @@
if (is.null(filename)) { filename <- "" }
bndbox <- extent(bndbox)
- res <- resolution(raster)
+ res <- res(raster)
# snap points to pixel boundaries
xmn <- round(xmin(bndbox) / res[1]) * res[1]
xmx <- round(xmax(bndbox) / res[1]) * res[1]
Added: pkg/raster/R/image.R
===================================================================
--- pkg/raster/R/image.R (rev 0)
+++ pkg/raster/R/image.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -0,0 +1,37 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : April 2009
+# Version 0.8
+# Licence GPL v3
+
+if (!isGeneric("image")) {
+ setGeneric("image", function(x,...)
+ standardGeneric("image"))
+}
+
+setMethod("image", signature(x='RasterLayer'),
+ function(x, maxdim=1000, ...) {
+ if (dataContent(x) != 'all') {
+# to do: should test if can read, else sample
+ if (canProcessInMemory(x, 2)) {
+ x <- readAll(x)
+ } else {
+ x <- sampleSkip(x, maxdim, asRaster=TRUE)
+ }
+ }
+ y <- yFromRow(x, nrow(x):1)
+ value <- t((values(x, format='matrix'))[nrow(x):1,])
+ x <- xFromCol(x,1:ncol(x))
+ image(x=x, y=y, z=value, ...)
+ }
+)
+
+
+setMethod("image", signature(x='RasterStack'),
+ function(x, y=1, maxdim=1000, ...) {
+ if (y < 1) { y <- 1 }
+ if (y > nlayers(x)) { y <- nlayers(x) }
+ image(x=x, y=y, maxdim=maxdim, ...)
+ }
+)
+
Modified: pkg/raster/R/map.R
===================================================================
--- pkg/raster/R/map.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/map.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -38,7 +38,7 @@
m <- values(object, format='matrix')[rows, cols]
sampraster <- raster(object)
- sampraster <- setRowCol(sampraster, dim(m)[1], dim(m)[2])
+ rowcol(sampraster) <- c(dim(m)[1], dim(m)[2])
xmax(sampraster) <- xmax(object) - (ncol(object) - cols[length(cols)]) * xres(object)
ymin(sampraster) <- ymin(object) + (nrow(object) - rows[length(rows)]) * yres(object)
object <- sampraster
Added: pkg/raster/R/persp.R
===================================================================
--- pkg/raster/R/persp.R (rev 0)
+++ pkg/raster/R/persp.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -0,0 +1,36 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : April 2009
+# Version 0.8
+# Licence GPL v3
+
+if (!isGeneric("persp")) {
+ setGeneric("persp", function(x,...)
+ standardGeneric("persp"))
+}
+
+setMethod("persp", signature(x='RasterLayer'),
+ function(x, maxdim=1000, ...) {
+ if (dataContent(x) != 'all') {
+# to do: should test if can read, else sample
+ if (canProcessInMemory(x, 2)) {
+ x <- readAll(x)
+ } else {
+ x <- sampleSkip(x, maxdim, asRaster=TRUE)
+ }
+ }
+ value <- t((values(x, format='matrix'))[nrow(x):1,])
+ y <- yFromRow(x, nrow(x):1)
+ x <- xFromCol(x,1:ncol(x))
+ persp(x=x, y=y, z=value, ...)
+ }
+)
+
+setMethod("persp", signature(x='RasterStack'),
+ function(x, y=1, maxdim=1000, ...) {
+ if (y < 1) { y <- 1 }
+ if (y > nlayers(x)) { y <- nlayers(x) }
+ persp(x=x, y=y, maxdim=maxdim, ...)
+ }
+)
+
Modified: pkg/raster/R/plot.R
===================================================================
--- pkg/raster/R/plot.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/plot.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -6,7 +6,7 @@
setMethod("plot", signature(x='RasterStack', y='ANY'),
- function(x, y, col=rev(terrain.colors(25)), subsample=TRUE, maxdim=500, addbox=TRUE, axes = TRUE, xlab="", ylab="", ...) {
+ function(x, y, col=rev(terrain.colors(255)), subsample=TRUE, maxdim=500, addbox=TRUE, axes = TRUE, xlab="", ylab="", ...) {
if (missing(y)) {
nl <- nlayers(x)
if (nl > 12) {
@@ -39,7 +39,7 @@
setMethod("plot", signature(x='RasterLayer', y='missing'),
- function(x, col=rev(terrain.colors(25)), subsample=TRUE, maxdim=500, addbox=TRUE, axes = TRUE, xlab="", ylab="", ...) {
+ function(x, col=rev(terrain.colors(255)), subsample=TRUE, maxdim=500, addbox=TRUE, axes = TRUE, xlab="", ylab="", ...) {
.plotraster(x, col=col, subsample=subsample, maxdim=maxdim, addbox=addbox, axes=axes, xlab=xlab, ylab=ylab, ...)
}
)
Modified: pkg/raster/R/polygonToRaster.R
===================================================================
--- pkg/raster/R/polygonToRaster.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/polygonToRaster.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -259,9 +259,9 @@
.polygonsToRaster2 <- function(spPolys, raster, field=0, filename="", datatype='FLT4S', overwrite=FALSE) {
-# This is based on sampling by points. Should be slower except when polygons very detailed and raster las ow resolution
+# This is based on sampling by points. Should be slower except when polygons very detailed and raster has low resolution
# but it could be optimized further
-
+# currently not used. Perhaps it should be used under certain conditions.
# this version does not deal with polygon holes
# check if bbox of raster and spPolys overlap
Modified: pkg/raster/R/rasterFromCells.R
===================================================================
--- pkg/raster/R/rasterFromCells.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/rasterFromCells.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -9,7 +9,7 @@
x <- unique(cells)
cols <- colFromCell(object, x)
rows <- rowFromCell(object, x)
- res <- resolution(object)
+ res <- res(object)
x1 <- xFromCol(object, min(cols)) - 0.5 * res[1]
x2 <- xFromCol(object, max(cols)) + 0.5 * res[1]
y1 <- yFromRow(object, max(rows)) - 0.5 * res[2]
Modified: pkg/raster/R/readSkip.R
===================================================================
--- pkg/raster/R/readSkip.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/readSkip.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -47,7 +47,7 @@
}
}
outras <- raster(raster)
- outras <- setRowCol(outras, nr, nc)
+ rowcol(outras) <- c(nr, nc)
xmax(outras) <- xmax(raster) - (ncol(raster) - cols[nc]) * xres(raster)
ymin(outras) <- ymin(raster) + (nrow(raster) - row) * yres(raster)
outras <- setValues(outras, dd)
Modified: pkg/raster/R/replaceProperties.R
===================================================================
--- pkg/raster/R/replaceProperties.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/replaceProperties.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -7,20 +7,15 @@
'ncol<-' <- function(x, value) {
- return( setRowCol(x, ncols=value) )
+ rowcol(x) <- c(nrow(x), value)
+ return(x)
}
'nrow<-' <- function(x, value) {
- return( setRowCol(x, nrows=value) )
+ rowcol(x) <- c(value, ncol(x))
+ return(x)
}
-'resolution<-' <- function(x, value) {
- if (length(value) == 1) {
- return( setRes(x, xres=value, yres=value) )
- } else {
- return( setRes(x, xres=value[1], yres=value[2]) )
- }
-}
'xmin<-' <- function(x, value) {
x at bbox@xmin <- value
Added: pkg/raster/R/resolution.R
===================================================================
--- pkg/raster/R/resolution.R (rev 0)
+++ pkg/raster/R/resolution.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -0,0 +1,33 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+
+'res<-' <- function(object, value) {
+ if (length(value) == 1) {
+ return( .setRes(object, xres=value, yres=value) )
+ } else {
+ return( .setRes(object, xres=value[1], yres=value[2]) )
+ }
+}
+
+
+.setRes <- function(object, xres, yres=xres) {
+ bb <- extent(object)
+ nc <- round( (bb at xmax - bb at xmin) / xres )
+ nr <- round( (bb at ymax - bb at ymin) / yres )
+ if (nr != object at nrows | nc != object at ncols) {
+ if (extends(class(object), "Raster")) {
+ object <- clearValues(object)
+ }
+ }
+ bb at xmax <- bb at xmin + nc * xres
+ bb at ymin <- bb at ymax - nr * yres
+ object <- setExtent(object, bb)
+ rowcol(object) <- c(nr, nc)
+ return(object)
+}
+
Deleted: pkg/raster/R/setDatatype.R
===================================================================
--- pkg/raster/R/setDatatype.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/setDatatype.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -1,107 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0.8
-# Licence GPL v3
-
-
-'dataType<-' <- function(x, value) {
-# for backward compatibility issues and non fatal mistakes.
- datatype <- substr( toupper( trim(value) ), 1, 5)
- if (datatype=='LOGIC') {datatype <- 'LOG1S'}
- if (datatype == 'INTEG') {datatype <- 'INT4S'}
- if (datatype == 'NUMER') {datatype <- 'FLT4S'}
- if (datatype == 'FLOAT') {datatype <- 'FLT4S'}
- if (datatype == 'DOUBL') {datatype <- 'FLT8S'}
- if (datatype == 'SINGL') {datatype <- 'FLT4S'}
- if (datatype == 'REAL') {datatype <- 'FLT4S'}
-
- if (nchar(datatype) < 3) {
- stop(paste('invalid datatype:', datatype))
- } else if (nchar(datatype) == 3) {
- if (datatype == 'LOG') {
- datatype <- paste(datatype, '1S', sep='')
- } else {
- datatype <- paste(datatype, '4S', sep='')
- }
- } else if (nchar(datatype) == 4) {
- if (datatype == 'INT1') {
- datatype <- paste(datatype, 'U', sep='')
- } else {
- datatype <- paste(datatype, 'S', sep='')
- }
- }
-
-# now for real
-
- if (!(substr(datatype, 1, 4) %in% c('LOG1', 'INT1', 'INT2', 'INT4', 'INT8', 'INT1', 'INT2', 'INT4', 'INT8', 'FLT4', 'FLT8'))) {
- stop('not a valid data type')
- }
- type <- substr(datatype,1,3)
- size <- substr(datatype,4,4)
- signed <- substr(datatype,1,3) != 'U'
-
- if (type == "FLT") {
- if (dataContent(x) != 'nodata') {
- x at data@values <- as.numeric(values(x))
- }
- if (size == '4') {
- x at file@datanotation <- 'FLT4S'
- x at file@nodatavalue <- -3.4E38
- } else if (size == '8') {
- x at file@datanotation <- 'FLT8S'
- x at file@nodatavalue <- -1.7E308
- } else {
- stop("invalid datasize for a FLT (should be 4 or 8)")
- }
- } else if (type == "INT") {
- x at data@min <- round(minValue(x))
- x at data@max <- round(maxValue(x))
- if (dataContent(x) != 'nodata') {
- x at data@values <- as.integer(round(values(x)))
- }
- if (size == '4') {
- if (signed) {
- x at file@datanotation <- 'INT4S'
- x at file@nodatavalue <- -2147483647
- } else {
- x at file@datanotation <- 'INT4U'
- x at file@nodatavalue <- 4294967295
- }
- } else if (size == '2') {
- if (signed) {
- x at file@datanotation <- 'INT2S'
- x at file@nodatavalue <- -32768
- } else {
- x at file@datanotation <- 'INT2U'
- x at file@nodatavalue <- 65535
- }
- } else if (size == '1') {
- # there is no nodata value for byte
- x at file@nodatavalue <- -9999
- if (signed) {
- x at file@datanotation <- 'INT1S'
- } else {
- x at file@datanotation <- 'INT1U'
- }
- warning("binary files of a single byte do not have NA values on disk")
- } else if (size == '8') {
- if (signed) {
- x at file@nodatavalue <- -9223372036854775808
- x at file@datanotation <- 'INT8S'
- } else {
- x at file@nodatavalue <- 18446744073709551615
- x at file@datanotation <- 'INT8U'
- }
- } else {
- stop("invalid datasize for this datatype")
- }
- } else if ( type == 'LOG' ) {
- x at file@nodatavalue <- -127
- x at file@datanotation <- 'LOG1S'
- } else {
- stop("unknown datatype")
- }
- return(x)
-}
-
Modified: pkg/raster/R/setRowCol.R
===================================================================
--- pkg/raster/R/setRowCol.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/setRowCol.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -5,30 +5,18 @@
# Licence GPL v3
-
-setRowCol <- function(object, nrows=nrow(object), ncols=ncol(object)) {
- if (extends(class(object), "Raster")) {
- object <- clearValues(object)
- #object at data@source <- 'ram'
+'rowcol<-' <- function(x, value) {
+ if (length(value) == 1) {
+ value <- c(value, ncol(x))
}
- object at ncols <- as.integer(ncols)
- object at nrows <- as.integer(nrows)
- return(object)
-}
-
-setRes <- function(object, xres, yres=xres) {
- if (extends(class(object), "Raster")) {
- object <- clearValues(object)
- #object at data@source <- 'ram'
+ if (value[1] != nrow(x) | value[2] != ncol(x)) {
+ if (extends(class(x), "Raster")) {
+ x <- clearValues(x)
+ }
}
- bb <- extent(object)
- nc <- round( (bb at xmax - bb at xmin) / xres )
- nr <- round( (bb at ymax - bb at ymin) / yres )
- bb at xmax <- bb at xmin + nc * xres
- bb at ymin <- bb at ymax - nr * yres
- object <- setExtent(object, bb)
- object <- setRowCol(object, nr, nc)
- return(object)
+ x at nrows <- as.integer(value[1])
+ x at ncols <- as.integer(value[2])
+ return(x)
}
Modified: pkg/raster/R/stackAdd.R
===================================================================
--- pkg/raster/R/stackAdd.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/stackAdd.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -51,7 +51,7 @@
if (class(raster) == 'RasterStack') {
rstack <- raster
} else {
- rstack <- setRowCol(rstack, nrow(raster), ncol(raster))
+ rowcol(rstack) <- c(nrow(raster), ncol(raster))
rstack <- setExtent(rstack, raster, snap=FALSE)
projection(rstack) <- projection(raster)
Modified: pkg/raster/R/writeAscii.R
===================================================================
--- pkg/raster/R/writeAscii.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/writeAscii.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -1,8 +1,7 @@
-
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
# Date : June 2008
-# Version 0,1
+# Version 0.8
# Licence GPL v3
Modified: pkg/raster/R/xyProperties.R
===================================================================
--- pkg/raster/R/xyProperties.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/xyProperties.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -33,7 +33,7 @@
return ( (ymax(object) - ymin(object)) / nrow(object))
}
-resolution <- function(object) {
+res <- function(object) {
return(c(xres(object), yres(object)))
}
Modified: pkg/raster/R/zonal.R
===================================================================
--- pkg/raster/R/zonal.R 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/R/zonal.R 2009-04-24 06:40:58 UTC (rev 429)
@@ -46,10 +46,12 @@
cnttab <- alltab
starttime <- proc.time()
for (r in 1:nrow(raster)) {
+ if (r %in% track) { .showTrack(r, raster at nrows, track, starttime) }
d <- cbind(valuesRow(raster, r), as.integer(valuesRow(zones, r)))
if (keepdata) {
d <- na.omit(d)
}
+ if (length(d) == 0) { next }
alltab <- c(alltab, tapply(d[,1], d[,2], fun))
if (counts) {
cnttab <- c(cnttab, tapply(d[,1], d[,2], length))
@@ -61,7 +63,6 @@
cnttab <- tapply(as.vector(cnttab), groups, sum)
}
}
- if (r %in% track) { .showTrack(r, raster at nrows, track, starttime) }
}
groups <- as.integer(names(alltab))
alltab <- tapply(as.vector(alltab), groups, fun)
Modified: pkg/raster/man/cellStats.Rd
===================================================================
--- pkg/raster/man/cellStats.Rd 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/man/cellStats.Rd 2009-04-24 06:40:58 UTC (rev 429)
@@ -2,12 +2,12 @@
\alias{cellStats}
-\title{Statistics for the cells of a single RasterLayer}
+\title{Cell statistics}
\description{
- Compute statistics for the cells of a single RasterLayer. In this package, functions such as max, min, mean
- with one or more RasterLayer objects as argument, will return another RasterLayer. CellStats returns a single value,
- computed from all the cell values of a single RasterLayer.
+Compute statistics for the cells of a single RasterLayer. In the \code{raster} package, functions such as max, min, and mean,
+when used with a RasterLayer objects as argument, return another RasterLayer. In contrasct, cellStats returns a single value,
+computed from the values of a single RasterLayer.
}
\usage{
@@ -15,20 +15,22 @@
}
\arguments{
- \item{raster}{A RasterLayer}
- \item{stat}{The function to be applied. Either as character: 'mean', 'min', 'max', 'sum', or 'sd'; or a function (see Details) }
- \item{track}{vector of row numbers for which the function will report that they have been processed}
+ \item{raster}{A RasterLayer}
+ \item{stat}{The function to be applied. Either as character: 'mean', 'min', 'max', 'sum', or 'sd'; or a function (see Details) }
+ \item{track}{Vector of row numbers for which the function will report that they have been processed}
}
\value{
- A numeric value.
+A numeric value.
}
\details{
-If \code{stat} is a \code{function} rather than a character string, \code{zonal} will fail (gracefully) for very large RasterLayers.
+If \code{stat} is a \code{function} rather than a character string, \code{zonal} will fail (gracefully) for very large RasterLayers. In such cases
+you can use the character string function name if applicable. Otherwise you could use a sample of the RasterLayer that can be held in memory (see
+\link[raster]{readRandom} and \link[raster]{readSkip} )
\code{stat='sd'} returns slightly different values than \code{stat=sd}, because the former computes the standard deviation of the population
-using this \code{sqrt((1/N) * sum(x^2) - mean(x)^2)} formula
+using this formula: \code{sqrt((1/N) * sum(x^2) - mean(x)^2)}
}
\seealso{ \code{\link[raster]{setMinMax} } }
@@ -40,8 +42,14 @@
r[] <- runif(ncell(r)) * 10
# works for large files
cellStats(r, 'mean')
-# does not work for very large files
+# same, but does not work for very large files
cellStats(r, mean)
+
+# not quite the same
+cellStats(r, 'sd')
+cellStats(r, sd)
+
}
+\keyword{spatial}
\keyword{univar}
Modified: pkg/raster/man/compare.Rd
===================================================================
--- pkg/raster/man/compare.Rd 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/man/compare.Rd 2009-04-24 06:40:58 UTC (rev 429)
@@ -30,7 +30,8 @@
r1 <- raster()
r2 <- r1
compare(c(r1, r2))
- r3 <- setRowCol(r1, 10)
+ r3 <- r1
+ nrow(r3) <- 10
# compare(c(r1, r3))
compare(c(r1, r3), stopiffalse=FALSE)
compare(c(r1, r3), rowcol=FALSE)
Modified: pkg/raster/man/contour.Rd
===================================================================
--- pkg/raster/man/contour.Rd 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/man/contour.Rd 2009-04-24 06:40:58 UTC (rev 429)
@@ -2,37 +2,47 @@
\docType{methods}
+\alias{contour}
\alias{contour,RasterLayer-method}
+\alias{contour,RasterStack-method}
-\title{Contour plot of a RasterLayer}
+\title{Contour plot}
\description{
-Contour plot of a RasterLayer.
+Contour plot of a RasterLayer. This is a generic function, in this package implemented for RasterLayer objects.
}
+\usage{
+contour(x, ...)
+}
+
+\arguments{
+ \item{x}{A Raster* object}
+ \item{...}{Any argument that can be passed to \code{\link[graphics]{contour}} (graphics package)}
+}
+
+
\section{Methods}{
\describe{
-\code{contour(x, ...)}
+\code{contour(x, y=1, z=NULL, ...)}
\tabular{rll}{
\tab \code{x} \tab a RasterLayer object \cr
+\tab \code{y} \tab a index of x = RasterStack \cr
+\tab \code{z} \tab values of z are ignored \cr
\tab \code{...} \tab Any argument that can be passed to \code{\link[graphics]{contour}} (graphics package) \cr
}
}}
+\seealso{ \code{\link[graphics]{contour}}, \code{\link[raster]{persp}}, \code{\link[raster]{plot}} }
-\details{
-
-}
-
-
\author{ Robert J. Hijmans }
\examples{
-r <- raster(nrows=36, ncols=18)
-r <- setValues(r, runif(ncell(r)))
+r <- raster(system.file("external/test.ag", package="sp"))
plot(r)
+contour(r, add=TRUE)
}
\keyword{methods}
Added: pkg/raster/man/dataType.Rd
===================================================================
--- pkg/raster/man/dataType.Rd (rev 0)
+++ pkg/raster/man/dataType.Rd 2009-04-24 06:40:58 UTC (rev 429)
@@ -0,0 +1,72 @@
+\name{dataType}
+
+\alias{dataType<-}
+\alias{dataType}
+
+\title{data type }
+
+\description{
+Get or set the datatype of a RasterLayer object. The datatype determines how values are stored on or written to disk.
+It does not directly affect the way they are stored in memory.
+}
+
+\usage{
+dataType(x)
+dataType(x) <- value
+}
+
+\arguments{
+ \item{x}{ A \code{RasterLayer} object }
+ \item{value}{ the type of data for writing values to disk. See below }
+}
+
+\details{
+Setting the data type is useful if you want to write values to disk. In other cases use functions such as round()
+
+Datatypes are described by 5 characters. The first three indicate whether the values are integers, decimal number or logical values. The fourth character indicates the number of bytes used to save the values on disk, and the last character indicates whether the numbers are signed (i.e. negative and positive values) or not (only zero and positive values)
+
+The following datatypes are available.
+
+\tabular{rll}{
+\bold{datatype} \tab \bold{min} \tab \bold{max} \cr
+\code{LOG1S} \tab FALSE (0)\tab TRUE (1) \cr
+\code{INT1S} \tab -127 \tab 127 \cr
+\code{INT1U} \tab 0 \tab 255 \cr
+\code{INT2S} \tab -32,767\tab 32,767 \cr
+\code{INT2U} \tab 0 \tab 65,534 \cr
+\code{INT4S} \tab -2,147,483,647 \tab 2,147,483,647 \cr
+\code{INT4U} \tab 0 \tab 4,294,967,294 \cr
+\code{INT8S} \tab -9,223,372,036,854,775,807 \tab 9,223,372,036,854,775,807 \cr
+\code{INT4U} \tab 0 \tab 18,446,744,073,709,551,614 \cr
+\code{FLT4S} \tab -3.4E38 \tab 3.4E38 \cr
+\code{FLT8S} \tab -1.7E308 \tab 1.7E308 \cr
+}
+
+For all integer types, except the single byte types, the lowest (signed) or highest (unsigned) value is used to store NA.
+Single byte files do not have NA values.
+Logical values are stored as signed single byte integers, they do have an NA value (-127)
+}
+
+\value{
+a Raster* object
+}
+
+\author{ Robert J. Hijmans }
+
+\examples{
+r <- raster()
+dataType(r)
+# 2 byte signed integer
+dataType(r) <- "INT2S"
+# 2 byte unsigned integer
+dataType(r) <- "INT2U"
+# very large integers
+dataType(r) <- "INT8S"
+# single byte values (0-255)
+dataType(r) <- "INT1U"
+#double precision decimal numbers
+dataType(r) <- "FLT8S"
+}
+
+\keyword{ spatial }
+
Modified: pkg/raster/man/dimensions.Rd
===================================================================
--- pkg/raster/man/dimensions.Rd 2009-04-23 14:08:25 UTC (rev 428)
+++ pkg/raster/man/dimensions.Rd 2009-04-24 06:40:58 UTC (rev 429)
@@ -7,36 +7,52 @@
\alias{dim,BasicRaster-method}
\alias{ncell}
\alias{ncell,ANY-method}
+\alias{nrow<-}
+\alias{ncol<-}
+\alias{rowcol<-}
+
\title{Dimensions}
\description{
- Get the number of rows, columns, or cells of a Raster* object
+ Get the number of rows, columns, or cells of a Raster* object; or set the number of rows and/columns
}
\usage{
ncol(x)
nrow(x)
ncell(x)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 429
More information about the Raster-commits
mailing list