[Raster-commits] r183 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jan 26 15:57:58 CET 2009
Author: rhijmans
Date: 2009-01-26 15:57:58 +0100 (Mon, 26 Jan 2009)
New Revision: 183
Added:
pkg/raster/man/project.Rd
pkg/raster/man/resample.Rd
Modified:
pkg/raster/R/all.classes.R
pkg/raster/R/bounding.box.R
pkg/raster/R/project.R
pkg/raster/R/properties.R
pkg/raster/R/resample.R
pkg/raster/R/set.R
pkg/raster/R/set.values.R
pkg/raster/man/properties.Rd
pkg/raster/man/set.Rd
Log:
Modified: pkg/raster/R/all.classes.R
===================================================================
--- pkg/raster/R/all.classes.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/all.classes.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -93,8 +93,8 @@
indices = 'vector',
colname = 'character',
haveminmax = 'logical',
- min = 'numeric',
- max = 'numeric',
+ min = 'vector',
+ max = 'vector',
source='character' # ram, disk
),
prototype (
@@ -103,8 +103,8 @@
indices = vector(mode='numeric'),
colname = '',
haveminmax = FALSE,
- min = Inf,
- max = -Inf,
+ min = c(Inf),
+ max = c(-Inf),
source='ram'
),
validity = function(object) {
@@ -134,8 +134,8 @@
colnames = 'vector',
nlayers='integer',
haveminmax = 'logical',
- min = 'numeric',
- max = 'numeric'
+ min = 'vector',
+ max = 'vector'
),
prototype (
values=matrix(NA,0,0),
@@ -144,8 +144,8 @@
colnames =vector(mode='character'),
nlayers=as.integer(0),
haveminmax = FALSE,
- min = Inf,
- max = -Inf
+ min = c(Inf),
+ max = c(-Inf)
),
validity = function(object) {
}
Modified: pkg/raster/R/bounding.box.R
===================================================================
--- pkg/raster/R/bounding.box.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/bounding.box.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -112,6 +112,7 @@
setBbox <- function(object, bndbox, keepres=FALSE, snap=FALSE) {
oldbb <- getBbox(object)
bb <- getBbox(bndbox)
+ newobj <- clearValues(object)
if (snap) {
bb at xmin <- max(bb at xmin, oldbb at xmin)
@@ -135,8 +136,7 @@
mx <- yFromRow(object, row) + 0.5 * yres(object)
if (abs(bb at ymax - mn) > abs(bb at ymax - mx)) { bb at ymax <- mx } else { bb at ymax <- mn }
}
-
- newobj <- clearValues(object)
+
newobj at bbox <- bb
if (keepres) {
@@ -155,9 +155,11 @@
indices <- cellsFromBbox(object, bb)
newobj <- setValues(newobj, values(object)[indices])
}
- } else if (ncol(object)==ncol(newobj) & nrow(object)==nrow(newobj)) {
- if (dataContent(object) == 'all') {
- newobj <- setValues(newobj, values(object))
+ } else if (class(object) != "BasicRaster") {
+ if (ncol(object)==ncol(newobj) & nrow(object)==nrow(newobj)) {
+ if (dataContent(object) == 'all') {
+ newobj <- setValues(newobj, values(object))
+ }
}
}
return(newobj)
Modified: pkg/raster/R/project.R
===================================================================
--- pkg/raster/R/project.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/project.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -1,41 +1,65 @@
-
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
-# Date : June 2008
-# Version 0,1
+# Date : January 2009
+# Version 0.8
# Licence GPL v3
-.xyProj <- function(xy, inProj, outProj) {
- if (!isLatLon(inProj)) {
- xy <- project(xy, inProj, inv=TRUE)
+
+
+projectBbox <- function(object, projstring) {
+ b <- getBbox(object)
+ projstring <- projection(projstring)
+ xy <- rbind(c(b at xmin, b at ymax), c(b at xmax, b at ymax), c(b at xmin, b at ymin), c(b at xmax, b at ymin))
+
+ if (isLatLon(projstring)) {
+ p <- project(xy, projstring, inv=FALSE)
+ } else {
+ b <- project(xy, projection(object), inv=TRUE)
+ p <- project(xy, projstring, inv=FALSE)
}
- xyproj <- project(xy, outProj, inv=FALSE)
- return(xyproj)
+ xmin <- min(p[,1])
+ xmax <- max(p[,1])
+ ymin <- min(p[,2])
+ ymax <- max(p[,2])
+ bb <- newBbox(xmin, xmax, ymin, ymax)
+ obj <- setBbox(object, bb)
+ obj <- setProjection(obj, projstring)
+ return(obj)
}
-projectRaster <- function(fromRaster, toRaster, method="nngb", overwrite=FALSE) {
+
+projectRaster <- function(from, to, method="nngb", overwrite=FALSE) {
# do the bounding boxes overlap at all?
# get .innerbox first?
# are the projs not NA and valid and not the same?
-warning("this function has not been tested yet. Not at all")
- rowCells <- 1:ncol(toRaster)
- inMemory <- filename(toRaster) == ""
+ rowCells <- 1:ncol(to)
+ inMemory <- filename(to) == ""
v <- vector(length=0)
- for (r in 1:nrow(toRaster)) {
- cells <- rowCells + (r-1) * ncol(toRaster)
- xy <- xyFromCell(toRaster, cells)
- projxy <- .xyProj(xy, projection(toRaster), projection(fromRaster))
- vals <- xyValues(fromRaster, projxy)
+ for (r in 1:nrow(to)) {
+ cells <- rowCells + (r-1) * ncol(to)
+ xy <- xyFromCell(to, cells)
+ if (isLatLon(from)) {
+ unProjXY <- project(xy, projection(to), inv=TRUE )
+ } else {
+ unProjXY <- project(xy, projection(from), inv=FALSE )
+ if (!isLatLon(to)) {
+ unProjXY <- project(unProjXY, projection(to), inv=TRUE )
+ }
+ }
+ vals <- xyValues(from, unProjXY)
if (inMemory) {
v <- c(v, vals)
} else {
- toRaster <- setValues(toRaster, vals, r)
- toRaster <- writeRaster(toRaster, overwrite=overwrite)
+ to <- setValues(to, vals, r)
+ to <- writeRaster(to, overwrite=overwrite)
}
}
if (inMemory) {
- toRaster <- setValues(toRaster, v)
+ to <- setValues(to, v)
+ if (filename(to) != "") {
+ to <- writeRaster(to, overwrite=overwrite)
+ }
}
- return(toRaster)
+ return(to)
}
Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/properties.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -174,14 +174,19 @@
}
projection <- function(object, asText=TRUE) {
+ if (extends(class(object), "BasicRaster")) { object <- object at crs
+ } else if (extends(class(object), "Spatial")) { object <- object at proj4string
+ } else if (class(object) == 'character') {return(object)
+ } else if (class(object) != "CRS") { stop(paste('cannot use this object of class', class(object))) }
+
if (asText) {
- if (is.na(object at crs@projargs)) {
+ if (is.na(object at projargs)) {
return("NA")
} else {
- return(trim(object at crs@projargs))
+ return(trim(object at projargs))
}
} else {
- return(object at crs)
+ return(object)
}
}
Modified: pkg/raster/R/resample.R
===================================================================
--- pkg/raster/R/resample.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/resample.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -1,32 +1,30 @@
-
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
-# Date : June 2008
-# Version 0,1
+# Date : Jaunary 2009
+# Version 0.8
# Licence GPL v3
-resample <- function(fromRaster, toRaster, method="nngb", overwrite=FALSE) {
+resample <- function(from, to, method="nngb", overwrite=FALSE) {
# do the bounding boxes overlap at all?
# get .innerbox first?
-warning("this function has not been tested yet. Not at all")
- rowCells <- 1:ncol(toRaster)
- inMemory <- filename(toRaster) == ""
+ rowCells <- 1:ncol(to)
+ inMemory <- filename(to) == ""
v <- vector(length=0)
- for (r in 1:nrow(toRaster)) {
- cells <- rowCells + (r-1) * ncol(toRaster)
- xy <- xyFromCell(toRaster, cells)
- vals <- xyValues(fromRaster, xy)
+ for (r in 1:nrow(to)) {
+ cells <- rowCells + (r-1) * ncol(to)
+ xy <- xyFromCell(to, cells)
+ vals <- xyValues(from, xy)
if (inMemory) {
v <- c(v, vals)
} else {
- toRaster <- setValues(toRaster, vals, r)
- toRaster <- writeRaster(toRaster, overwrite=overwrite)
+ to <- setValues(to, vals, r)
+ to <- writeRaster(to, overwrite=overwrite)
}
}
if (inMemory) {
- toRaster <- setValues(toRaster, v)
+ to <- setValues(to, v)
}
- return(toRaster)
+ return(to)
}
Modified: pkg/raster/R/set.R
===================================================================
--- pkg/raster/R/set.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/set.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -18,13 +18,15 @@
}
setRes <- function(object, xres, yres=xres) {
- object <- clearValues(object)
+ if (extends(class(object), "Raster")) {
+ object <- clearValues(object)
+ }
bb <- getBbox(object)
- nc <- (bb at xmax - bb at xmin) / xres
- nr <- (bb at ymax - bb at ymin) / yres
+ 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 <- setBbox(object, bb, snap=FALSE)
+ object <- setBbox(object, bb)
object <- setRowCol(object, nr, nc)
return(object)
}
@@ -69,38 +71,8 @@
-.xyBbox <- function(object) {
- b <- getBbox(object)
- xy <- c(b at xmin, b at ymax)
- xy <- rbind(xy, c(b at xmax, b at ymax))
- xy <- rbind(xy, c(b at xmin, b at ymin))
- xy <- rbind(xy, c(b at xmax, b at ymin))
- colnames(xy) <- c("x", "y")
- rownames(xy)[1] <- ""
- return(xy)
-}
-
-setProjection <- function(object, projstring, adjustBbox=FALSE) {
- if (adjustBbox) {
- b <- .xyBbox(object)
- if (isLatLon(object)) {
- p <- project(b, projstring, inv=FALSE)
- } else {
- b <- project(b, projection(object), inv=TRUE)
- if (isLatLon(projstring)) {
- p <- b
- } else {
- p <- project(b, projstring, inv=FALSE)
- }
- }
- xmin <- min(p[,1])
- xmax <- max(p[,1])
- ymin <- min(p[,2])
- ymax <- max(p[,2])
- bb <- newBbox(xmin, xmax, ymin, ymax)
- object <- setBbox(object, bb)
- }
+setProjection <- function(object, projstring) {
if (class(projstring)=="CRS") {
object at crs <- projstring
} else {
Modified: pkg/raster/R/set.values.R
===================================================================
--- pkg/raster/R/set.values.R 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/R/set.values.R 2009-01-26 14:57:58 UTC (rev 183)
@@ -55,6 +55,9 @@
clearValues <- function(object) {
+ if (class(object) == "BasicRaster") {
+ return(object)
+ }
object at data@content <- 'nodata'
object at data@indices = vector(mode='numeric')
if (class(object) == 'RasterStack') {
Added: pkg/raster/man/project.Rd
===================================================================
--- pkg/raster/man/project.Rd (rev 0)
+++ pkg/raster/man/project.Rd 2009-01-26 14:57:58 UTC (rev 183)
@@ -0,0 +1,42 @@
+\name{project}
+\alias{projectRaster}
+\alias{projectBbox}
+
+\title{Change the projection of a RasterLayer}
+\description{
+ Change the projection of a RasterLayer
+}
+\usage{
+projectRaster(from, to, method="nngb", overwrite=FALSE)
+projectBbox(object, projstring)
+}
+
+\arguments{
+ \item{from}{a RasterLayer object}
+ \item{to}{a BasicRaster object (or any Raster* object}
+ \item{method}{}
+ \item{overwrite}{}
+ \item{object}{}
+ \item{projstring}{}
+}
+
+\details{
+ first create projected bbox (in BasicRaster object). Then project.
+}
+
+\value{
+ a new RasterLayer object (in the R environment), with, in some cases, the side-effect of the raster values written to disk
+}
+\author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
+
+\examples{
+r <- newRaster(-120, -80, 30, 60, ncols=40, nrows=30)
+r <- setValues(r, 1:ncell(r))
+newproj <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100"
+bb <- projectBbox(r, newproj)
+bb <- setRes(bb, 100000)
+rp <- projectRaster(r, bb)
+}
+
+\keyword{spatial}
+
Modified: pkg/raster/man/properties.Rd
===================================================================
--- pkg/raster/man/properties.Rd 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/man/properties.Rd 2009-01-26 14:57:58 UTC (rev 183)
@@ -19,6 +19,8 @@
\alias{projection}
\alias{isLatLon}
\alias{isLatLon,Raster-method}
+\alias{isLatLon,CRS-method}
+\alias{isLatLon,character-method}
\alias{projection<-}
\alias{origin}
\alias{nlayers}
Added: pkg/raster/man/resample.Rd
===================================================================
--- pkg/raster/man/resample.Rd (rev 0)
+++ pkg/raster/man/resample.Rd 2009-01-26 14:57:58 UTC (rev 183)
@@ -0,0 +1,34 @@
+\name{resample}
+\alias{resample}
+
+\title{Resample}
+\description{
+ Resample
+}
+\usage{
+resample(from, to, method="nngb", overwrite=FALSE)
+}
+
+\arguments{
+ \item{from}{a RasterLayer object}
+ \item{to}{a BasicRaster object (or any Raster* object}
+ \item{method}{}
+ \item{overwrite}{}
+}
+
+\details{
+ resmaple
+}
+
+\value{
+ a new RasterLayer object (in the R environment), with, in some cases, the side-effect of the raster values written to disk
+}
+\author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
+
+\examples{
+r1 <- newRaster()
+
+}
+
+\keyword{spatial}
+
Modified: pkg/raster/man/set.Rd
===================================================================
--- pkg/raster/man/set.Rd 2009-01-26 10:52:15 UTC (rev 182)
+++ pkg/raster/man/set.Rd 2009-01-26 14:57:58 UTC (rev 183)
@@ -14,7 +14,7 @@
}
\usage{
-setProjection(object, projstring, adjustBbox=FALSE)
+setProjection(object, projstring)
setFilename(object, filename)
setRaster(object, filename="", values=NA)
setDatatype(raster, datatype, datasize)
@@ -36,7 +36,6 @@
\item{yres}{ the new y resolution}
\item{projstring}{a character string describing a projection and datum in PROJ4 format }
\item{readfromdisk}{Logical. If \code{TRUE} then data are read from disk (if available) to determine the min and max value}
- \item{adjustBbox}{}
}
\details{
More information about the Raster-commits
mailing list