[Raster-commits] r237 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 3 03:08:51 CET 2009
Author: rhijmans
Date: 2009-02-03 03:08:51 +0100 (Tue, 03 Feb 2009)
New Revision: 237
Added:
pkg/raster/R/coercion.R
Removed:
pkg/raster/R/conversion.R
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/set.values.R
pkg/raster/R/stack.R
pkg/raster/man/classes.Rd
pkg/raster/man/coerce.Rd
pkg/raster/man/create.stack.Rd
pkg/raster/man/pointToRaster.Rd
pkg/raster/man/saveStack.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/DESCRIPTION 2009-02-03 02:08:51 UTC (rev 237)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.7-8
-Date: 2-Feb-2009
+Version: 0.8.7-9
+Date: 3-Feb-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/coercion.R
===================================================================
--- pkg/raster/R/coercion.R (rev 0)
+++ pkg/raster/R/coercion.R 2009-02-03 02:08:51 UTC (rev 237)
@@ -0,0 +1,204 @@
+# R code for changing rasters (spatial data)
+# Authors: Robert J. Hijmans
+# International Rice Research Institute
+#contact: r.hijmans at gmail.com
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+
+.asSpGrid <- function(object, type='grid', dataframe=TRUE) {
+ bb <- .toSpBbox(object)
+ cs <- resolution(object)
+ cc <- bb[,1] + (cs/2)
+ cd <- ceiling(diff(t(bb))/cs)
+ grd <- GridTopology(cellcentre.offset=cc, cellsize=cs, cells.dim=cd)
+ if (dataframe) {
+ if (dataContent(object) != 'all') {
+ object <- readAll(object)
+ }
+ data <- values(object)
+ data <- as.data.frame(data)
+ }
+ if (type=='pixel') {
+ object <- makeSparse(object)
+ pts <- SpatialPoints(xyFromCell(object, dataIndices(object)))
+ if (dataframe) {
+ sp <- SpatialPixelsDataFrame(points=pts, data=data, proj4string=projection(object, FALSE))
+ } else {
+ sp <- SpatialPixels(points=pts, proj4string=projection(object, FALSE))
+ }
+ } else if (type=='grid') {
+ if (dataframe) {
+ sp <- SpatialGridDataFrame(grd, proj4string=projection(object, FALSE), data=data)
+ } else {
+ sp <- SpatialGrid(grd, proj4string=projection(object, FALSE))
+ }
+ }
+ return(sp)
+}
+
+setAs('RasterLayer', 'SpatialPixels',
+ function(from) { return(.asSpGrid(from, type='pixel', FALSE)) }
+)
+
+setAs('RasterLayer', 'SpatialPixelsDataFrame',
+ function(from) { return(.asSpGrid(from, type='pixel', TRUE)) }
+)
+
+setAs('RasterLayer', 'SpatialGrid',
+ function(from) { return(.asSpGrid(from, type='grid', FALSE)) }
+)
+
+setAs('RasterLayer', 'SpatialGridDataFrame',
+ function(from) { return(.asSpGrid(from, type='grid', TRUE)) }
+)
+
+
+setAs('RasterStack', 'SpatialGridDataFrame',
+ function(from) { return(.asSpGrid(from, type='grid', TRUE)) }
+)
+
+
+setAs('RasterStack', 'RasterLayer',
+ function(from){ return(asRasterLayer (from)) }
+)
+
+
+setAs('SpatialGridDataFrame', 'RasterLayer',
+ function(from){ return(asRasterLayer (from)) }
+)
+
+setAs('SpatialPixelsDataFrame', 'RasterLayer',
+ function(from){ return(asRasterLayer (from)) }
+)
+
+setAs('SpatialGrid', 'RasterLayer',
+ function(from){ return(asRasterLayer (from)) }
+)
+
+setAs('SpatialPixels', 'RasterLayer',
+ function(from){ return(asRasterLayer (from)) }
+)
+
+
+setAs('SpatialGrid', 'RasterStack',
+ function(from){ return(.asRasterStack (from)) }
+)
+
+setAs('SpatialGridDataFrame', 'RasterStack',
+ function(from){ return(.asRasterStack (from)) }
+)
+
+setAs('SpatialPixels', 'RasterStack',
+ function(from){ return(.asRasterStack (from)) }
+)
+
+setAs('SpatialPixelsDataFrame', 'RasterStack',
+ function(from){ return(.asRasterStack (from)) }
+)
+
+
+
+if (!isGeneric("asRasterLayer")) {
+ setGeneric("asRasterLayer", function(object, index)
+ standardGeneric("asRasterLayer"))
+}
+
+
+setMethod('asRasterLayer', signature(object='RasterStack'),
+ function(object, index=1){
+ if (nlayers(object) > 0) {
+ dindex <- max(1, min(nlayers(object), index))
+ if (dindex != index) { warning(paste("index was changed to", dindex))}
+ rs <- object at layers[[dindex]]
+ if (dataContent(object) == 'all') {
+ rs <- setValues(rs, values(object)[,dindex])
+ }
+ } else {
+ rs <- new("RasterLayer")
+ rs <- setBbox(rs, getBbox(object))
+ rs <- setRowCol(rs, nrow(object), ncol(object))
+ }
+ return(rs)
+ }
+)
+
+
+
+setMethod('asRasterLayer', signature(object='SpatialPixelsDataFrame'),
+ function(object, index=1){
+ r <- raster()
+ r <- setBbox(r, getBbox(object))
+ r <- setProjection(r, object at proj4string)
+ r <- setRowCol(r, object at grid@cells.dim[2], object at grid@cells.dim[1])
+ dindex <- max(1, min(dim(object 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
+ sparse <- FALSE
+ if (!sparse) {
+ object <- as(object, 'SpatialGridDataFrame')
+ r <- setValues(r, object at data[[dindex]])
+ } else {
+ cells <- object at grid.index
+ if (length(cells)==0) {
+ cells <- cellFromXY(r, object at coords)
+ }
+ r <- setValuesSparse(r, cells, object at data[[dindex]])
+ }
+ return(r)
+ }
+)
+
+
+
+setMethod('asRasterLayer', signature(object='SpatialGridDataFrame'),
+ function(object, index=1){
+ r <- raster()
+ r <- setBbox(r, getBbox(object))
+ r <- setProjection(r, object at proj4string)
+ r <- setRowCol(r, object at grid@cells.dim[2], object at grid@cells.dim[1])
+ dindex <- max(1, min(dim(object at data)[2], index))
+ if (dindex != index) { warning(paste("index was changed to", dindex))}
+ r <- setValues(r, object at data[[dindex]])
+ return(r)
+ }
+)
+
+
+
+
+.asRasterStack <- function(spgrid) {
+ stk <- new("RasterStack")
+ stk <- setBbox(stk, getBbox(spgrid))
+ stk <- setProjection(stk, spgrid at proj4string)
+ stk <- setRowCol(stk, spgrid at grid@cells.dim[2], spgrid at grid@cells.dim[1])
+
+ if (class(spgrid)=='SpatialPixelsDataFrame') {
+ spgrid <- as(spgrid, 'SpatialGridDataFrame')
+ }
+ if (class(spgrid)=='SpatialGridDataFrame' ) {
+ stk <- setValues(stk, as.matrix(spgrid at data))
+ rs <- as(stk, 'RasterLayer')
+ stk <- setValues(stk, as.matrix(spgrid at data))
+ for (i in 1:ncol(spgrid at data)) {
+ stk at layers[i] <- rs
+ }
+ }
+ return(stk)
+}
+
+
+.toSpBbox <- function(object) {
+ b <- getBbox(object)
+ bb <- matrix(NA, 2, 2)
+ bb[1,1] <- b at xmin
+ bb[1,2] <- b at xmax
+ bb[2,1] <- b at ymin
+ bb[2,2] <- b at ymax
+ return(bb)
+}
+
+
Deleted: pkg/raster/R/conversion.R
===================================================================
--- pkg/raster/R/conversion.R 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/R/conversion.R 2009-02-03 02:08:51 UTC (rev 237)
@@ -1,217 +0,0 @@
-# R code for changing rasters (spatial data)
-# Authors: Robert J. Hijmans
-# International Rice Research Institute
-#contact: r.hijmans at gmail.com
-# Date : October 2008
-# Version 0.8
-# Licence GPL v3
-
-
-
-
-setAs('SpatialGridDataFrame', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
-)
-
-setAs('SpatialGrid', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
-)
-
-setAs('SpatialPixelsDataFrame', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
-)
-
-setAs('SpatialPixels', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
-)
-
-
-
-setAs('RasterLayer', 'SpatialGridDataFrame',
- function(from){ return(asSpGrid (from)) }
-)
-
-setAs('RasterStack', 'RasterLayer',
- function(from){ return(asRasterLayer (from)) }
-)
-
-
-
-
-if (!isGeneric("asRasterLayer")) {
- setGeneric("asRasterLayer", function(object,index)
- standardGeneric("asRasterLayer"))
-}
-setMethod('asRasterLayer', signature(object='missing',index='missing'),
- function(object){
- return(raster())
- }
-)
-setMethod('asRasterLayer', signature(object='character',index='missing'),
- function(object){
- r <- raster()
- if (object == 'runif') {
- r <- setValues(r, runif(ncell(r)))
- } else if (object == 'seq') {
- r <- setValues(r, 1:ncell(r))
- }
- return(r)
- }
-)
-
-setMethod('asRasterLayer', signature(object='Raster',index='missing'),
- function(object){
- return(asRasterLayer(object, 1))
- }
-)
-setMethod('asRasterLayer', signature(object='SpatialPixels',index='missing'),
- function(object){
- return(asRasterLayer(object, 1))
- }
-)
-
-
-setMethod('asRasterLayer', signature(object='RasterLayer', index='numeric'),
- function(object, index){
- return(object)
- }
-)
-
-setMethod('asRasterLayer', signature(object='RasterStack', index='numeric'),
- function(object, index){
- if (nlayers(object) > 0) {
- dindex <- max(1, min(nlayers(object), index))
- if (dindex != index) { warning(paste("index was changed to", dindex))}
- rs <- object at layers[[dindex]]
- if (dataContent(object) == 'all') {
- rs <- setValues(rs, values(object)[,dindex])
- }
- } else {
- rs <- new("RasterLayer")
- rs <- setBbox(rs, getBbox(object))
- rs <- setRowCol(rs, nrow(object), ncol(object))
- }
- return(rs)
- }
-)
-
-
-
-setMethod('asRasterLayer', signature(object='SpatialPixels', index='numeric'),
- function(object, index){
- r <- raster()
- r <- setBbox(r, getBbox(object))
- r <- setProjection(r, object at proj4string)
- r <- setRowCol(r, object at grid@cells.dim[2], object at grid@cells.dim[1])
- return(r)
- }
-)
-
-setMethod('asRasterLayer', signature(object='SpatialPixelsDataFrame', index='numeric'),
- function(object, index){
- raster <- asRasterLayer(as(object, "SpatialPixels"))
- dindex <- max(1, min(dim(object at data)[2], index))
- if (dindex != index) { warning(paste("index was changed to", dindex))}
- sparse <- FALSE
- if (!sparse) {
- object <- as(object, 'SpatialGridDataFrame')
- raster <- setValues(raster, object at data[[dindex]])
- } else {
- cells <- object at grid.index
- if (length(cells)==0) {
- cells <- cellFromXY(raster, object at coords)
- }
- raster <- setValuesSparse(raster, cells, object at data[[dindex]])
- }
- return(raster)
- }
-)
-
-setMethod('asRasterLayer', signature(object='SpatialGridDataFrame', index='numeric'),
- function(object, index){
- raster <- asRasterLayer(as(object, "SpatialPixels"))
- dindex <- max(1, min(dim(object at data)[2], index))
- if (dindex != index) { warning(paste("index was changed to", dindex))}
- raster <- setValues(raster, object at data[[dindex]])
- return(raster)
- }
-)
-
-
-
-
-setAs('SpatialGrid', 'RasterStack',
- function(from){ return(asRasterStack (from)) }
-)
-
-setAs('SpatialGridDataFrame', 'RasterStack',
- function(from){ return(asRasterStack (from)) }
-)
-
-setAs('SpatialPixelsDataFrame', 'RasterStack',
- function(from){ return(asRasterStack (from)) }
-)
-
-setAs('SpatialPixels', 'RasterStack',
- function(from){ return(asRasterStack (from)) }
-)
-
-
-.asRasterStack <- function(spgrid) {
- stk <- new("RasterStack")
- stk <- setBbox(stk, getBbox(spgrid))
- stk <- setProjection(stk, spgrid at proj4string)
- stk <- setRowCol(stk, spgrid at grid@cells.dim[2], spgrid at grid@cells.dim[1])
-
- if (class(spgrid)=='SpatialPixelsDataFrame') {
- spgrid <- as(spgrid, 'SpatialGridDataFrame')
- }
- if (class(spgrid)=='SpatialGridDataFrame' ) {
- stk <- setValues(stk, as.matrix(spgrid at data))
- rs <- as(stk, 'RasterLayer')
- stk <- setValues(stk, as.matrix(spgrid at data))
- for (i in 1:ncol(spgrid at data)) {
- stk at layers[i] <- rs
- }
- }
- return(stk)
-}
-
-
-.toSpBbox <- function(object) {
- b <- getBbox(object)
- bb <- matrix(NA, 2, 2)
- bb[1,1] <- b at xmin
- bb[1,2] <- b at xmax
- bb[2,1] <- b at ymin
- bb[2,2] <- b at ymax
- return(bb)
-}
-
-
-
-asSpGrid <- function(object, type='grid') {
- bb <- .toSpBbox(object)
- cs <- resolution(object)
- cc <- bb[,1] + (cs/2)
- cd <- ceiling(diff(t(bb))/cs)
- grd <- GridTopology(cellcentre.offset=cc, cellsize=cs, cells.dim=cd)
- if (type=='pixel') {
- object <- makeSparse(object)
- pts <- SpatialPoints(xyFromCell(object, dataIndices(object)))
- data <- values(object)
- data <- as.data.frame(data)
- sp <- SpatialPixelsDataFrame(points=pts, data=data, proj4string=projection(object, FALSE))
-
- } else if (type=='grid') {
- if ( dataContent(object) == 'all') {
- data <- values(object)
- data <- as.data.frame(data)
- sp <- SpatialGridDataFrame(grd, proj4string=projection(object, FALSE), data=data)
- } else {
- sp <- SpatialGrid(grd, proj4string=projection(object, FALSE))
- }
- }
- return(sp)
-}
-
Modified: pkg/raster/R/set.values.R
===================================================================
--- pkg/raster/R/set.values.R 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/R/set.values.R 2009-02-03 02:08:51 UTC (rev 237)
@@ -145,7 +145,7 @@
if ( dataContent(raster) == 'all') {
vals <- seq(1:ncell(raster))
vals <- cbind(vals, values(raster))
- vals <- as.vector(na.omit(vals))
+ vals <- na.omit(vals)
raster <- setValuesSparse(raster, sparsevalues=vals[,2], cellnumbers=vals[,1])
return(raster)
} else {
Modified: pkg/raster/R/stack.R
===================================================================
--- pkg/raster/R/stack.R 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/R/stack.R 2009-02-03 02:08:51 UTC (rev 237)
@@ -35,7 +35,29 @@
}
+#if (!isGeneric("stack")) {
+# setGeneric("stack", function(x, ...)
+# standardGeneric("stack"))
+#}
+
+#setMethod("stack", signature(x='RasterLayer'),
+#function(x, ...) {
+# rlist <- c(x, list(...))
+# for (i in 1:length(rlist)) {
+# if (is.character(rlist[[i]])) {
+# rlist[i] <- rasterFromFile(rlist[[i]])
+# } else {
+# if (class(rlist[[i]]) != "RasterLayer") {
+# stop("Arguments should be RasterLayer objects or filenames")
+# }
+# }
+# }
+# return(addRasters(new("RasterStack"), rlist))
+#} )
+
+
+
if (!isGeneric("makeStack")) {
setGeneric("makeStack", function(x, ...)
standardGeneric("makeStack"))
Modified: pkg/raster/man/classes.Rd
===================================================================
--- pkg/raster/man/classes.Rd 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/man/classes.Rd 2009-02-03 02:08:51 UTC (rev 237)
@@ -1,4 +1,4 @@
-\name{RasterLayer-class}
+\name{classes}
\docType{class}
Modified: pkg/raster/man/coerce.Rd
===================================================================
--- pkg/raster/man/coerce.Rd 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/man/coerce.Rd 2009-02-03 02:08:51 UTC (rev 237)
@@ -1,33 +1,24 @@
\name{Coercion}
-\alias{asRasterLayer,missing,missing-method}
-\alias{asRasterLayer,character,missing-method}
-\alias{asRasterLayer,Raster,missing-method}
-\alias{asRasterLayer,RasterLayer,numeric-method}
-\alias{asRasterLayer,RasterStack,numeric-method}
-\alias{asRasterLayer,SpatialPixels,missing-method}
-\alias{asRasterLayer,SpatialPixels,numeric-method}
-\alias{asRasterLayer,SpatialPixelsDataFrame,numeric-method}
-\alias{asRasterLayer,SpatialGridDataFrame,numeric-method}
+\alias{asRasterLayer,RasterStack-method}
+\alias{asRasterLayer,SpatialPixelsDataFrame-method}
+\alias{asRasterLayer,SpatialGridDataFrame-method}
\alias{asRasterLayer}
-\alias{asSpGrid}
-\title{ Coercion of Raster*, SpatialGrid and SpatialPixels* objects. }
+\title{ Coercion of SpatialGridDataFrame and SpatialPixelsDataFrame objects to a RasterLayer. }
\description{
-Functions to coerce a Raster* objects into an sp SpatialGridDataFrame object and
-to coerce a RasterLayer or RasterStack object from a sp SpatialPixels* or SpatialGrid* object
+Functions to coerce a SpatialGridDataFrame, SpatialPixelsDataFrame, and RasterStack objects to a RasterLayer object.
+You can use as( , ) for these coercions (see examples), and for many other coercions between sp and raster objects, but asRasterLayer allows for indicating which variable should be passed to the RasterLayer object.
+RasterLayer objects only have a single variable, whereas a RasterStack and the Spatial* objects can have multiple variables.
}
\usage{
-asRasterLayer(object, index)
-asSpGrid(object, type='grid')
+asRasterLayer(object, index=1)
}
\arguments{
\item{object}{ a Raster* type object (SpatialPixel, SpatialPixelDataFrame , SpatialGrid, or SpatialGridDataFrame }
- \item{spgrid}{ a sp raster type object (SpatialPixel, SpatialPixelDataFrame , SpatialGrid, or SpatialGridDataFrame }
- \item{index}{integer values >= 1 indicating the layer in the RasterStack, or the column in the sp object dataframe to take the values from}
- \item{type}{character. Indicating what type of sp object to return. Should be 'pixel' or 'grid'.}
+ \item{index}{integer >= 1 indicating the layer in the RasterStack, or the column in the sp object dataframe to take the values from}
}
\details{
@@ -36,22 +27,28 @@
In most cases you can also coerce objects using setAs, except that you cannot change the default 'index' (variable) and the first variable (column of the data frame of a Spatial* object) is used.
- e.g.: setAs(aSpatialPixelsDataFrame, "RasterStack") or setAs(aRasterLayer, "SpatialGridDataFrame")
-
-)
-
+ e.g.: as(aSpatialPixelsDataFrame, "RasterStack") or as(aRasterLayer, "SpatialGridDataFrame")
}
\value{
- a Raster or a sp object
+a RasterLayer object
}
-\author{ Robert J. Hijmans \email{r.hijmans at gmail.com} }
+\author{ Robert J. Hijmans}
+\seealso{ \code{\link[raster]{RasterLayer-class}}, \code{\link[sp]{SpatialGridDataFrame-class}}, \code{\link[methods]{as}}}
+
\examples{
- rs <- raster()
- rs <- setValues(rs, 1:ncell(rs))
- sp <- asSpGrid(rs)
- rs2 <- asRasterLayer(sp)
+r1 <- raster(ncols=90, nrows=45)
+r1 <- setValues(r1, 1:ncell(r1))
+r2 <- setValues(r1, 1:ncell(r1))
+stk <- makeStack(r1, r2)
+sp <- as(stk, 'SpatialGridDataFrame')
+r3 <- asRasterLayer(sp, 2)
+as(r2, 'BasicRaster') == as(r3, 'BasicRaster')
+sum(values(r2) == values(r3)) == ncell(r2)
+r4 <- asRasterLayer(stk, 1)
+sp <- as(r4, 'SpatialPixels')
+sp <- as(r4, 'SpatialGridDataFrame')
}
\keyword{ spatial }
Modified: pkg/raster/man/create.stack.Rd
===================================================================
--- pkg/raster/man/create.stack.Rd 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/man/create.stack.Rd 2009-02-03 02:08:51 UTC (rev 237)
@@ -7,9 +7,9 @@
\alias{addRasters}
\alias{dropLayer}
-\title{ Create or change a new stack }
+\title{ Create or change a new RasterStack }
\description{
- A raster stack is a collection of rasters with the same spatial extent and resolution. They can be crated from RasterLayer objects, or from raster files.
+ A RasterStack is a collection of rasters with the same spatial extent and resolution. They can be crated from RasterLayer objects, or from raster files.
You can add raster to or remove raster from a rasterstack.
}
@@ -31,16 +31,17 @@
\item{indices}{ the indices of the raster(s) to remove from a RasterStack }
}
\details{
- When a stack is saved to a file, only pointers (filenames) to raster datasets are saved, not the data. If the name or location of a raster file changes, the stack becomes invalid.
+ When a RasterStack is saved to a file, only pointers (filenames) to raster datasets are saved, not the data. If the name or location of a raster file changes, the RasterStack becomes invalid.
In stackFromFiles, use index=-1 to add all bands of a single file to the RasterStack
}
\value{
- a stack object
+ a RasterStack object
}
-\author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
+\author{Robert J. Hijmans}
-\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ }
+\seealso{ \code{\link[raster]{raster}}, \code{\link[raster]{rasterFromFile}}}
+
\examples{
rasterfile <- system.file("external/test.ag", package="sp")
st <- stackFromFiles(rasterfile)
Modified: pkg/raster/man/pointToRaster.Rd
===================================================================
--- pkg/raster/man/pointToRaster.Rd 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/man/pointToRaster.Rd 2009-02-03 02:08:51 UTC (rev 237)
@@ -29,6 +29,8 @@
}
\author{Robert J. Hijmans}
+\seealso{ \code{\link[raster]{linesToRaster}}, \code{\link[raster]{polygonsToRaster}}}
+
\examples{
r <- raster(ncols=36, nrows=18)
n <- 1000
Modified: pkg/raster/man/saveStack.Rd
===================================================================
--- pkg/raster/man/saveStack.Rd 2009-02-02 14:52:39 UTC (rev 236)
+++ pkg/raster/man/saveStack.Rd 2009-02-03 02:08:51 UTC (rev 237)
@@ -1,11 +1,11 @@
-\name{rasterstack.create}
+\name{saverasterstack}
\alias{stackSave}
\alias{stackOpen}
-\title{ Create or change a new stack }
+\title{ Save or open a RasterStack file }
\description{
- A raster stack is a collection of rasters with the same spatial extent and resolution. They can be crated from RasterLayer objects, or from raster files.
- These two functions allow you to save the references to raster files and recreate a rasterStack object later.
+ A RasterStack is a collection of rasters with the same spatial extent and resolution. They can be crated from RasterLayer objects, or from raster files.
+ These two functions allow you to save the references to raster files and recreate a rasterStack object later. The values are not saved, only the references to the files.
}
\usage{
@@ -14,20 +14,21 @@
}
\arguments{
- \item{stackfile}{ Filename for the stack (to save it on disk) }
+ \item{stackfile}{ Filename for the RasterStack (to save it on disk) }
\item{rstack}{ a RasterStack object }
}
\details{
- When a stack is saved to a file, only pointers (filenames) to raster datasets are saved, not the data. If the name or location of a raster file changes, the stack becomes invalid.
+ When a RasterStack is saved to a file, only pointers (filenames) to raster datasets are saved, not the data. If the name or location of a raster file changes, the RasterStack becomes invalid.
In stackFromFiles, use index=-1 to add all bands of a single file to the RasterStack
+}
-}
\value{
- a stack object
+ a RasterStack object
}
\author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
-\seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ }
+\seealso{ \code{\link[raster]{raster}}, \code{\link[raster]{rasterFromFile}}}
+
\examples{
rasterfile <- system.file("external/test.ag", package="sp")
st <- stackFromFiles(c(rasterfile, rasterfile))
More information about the Raster-commits
mailing list