[Raster-commits] r176 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jan 23 10:26:46 CET 2009
Author: rhijmans
Date: 2009-01-23 10:26:46 +0100 (Fri, 23 Jan 2009)
New Revision: 176
Added:
pkg/raster/R/write.R
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/bounding.box.R
pkg/raster/R/set.values.R
pkg/raster/R/show.R
pkg/raster/R/standard.generic.functions.R
pkg/raster/R/writeRaster.R
pkg/raster/man/write.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/DESCRIPTION 2009-01-23 09:26:46 UTC (rev 176)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.6-4
-Date: 22-Jan-2009
+Version: 0.8.6-5
+Date: 23-Jan-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>
Modified: pkg/raster/R/bounding.box.R
===================================================================
--- pkg/raster/R/bounding.box.R 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/R/bounding.box.R 2009-01-23 09:26:46 UTC (rev 176)
@@ -86,9 +86,29 @@
)
+bbIndices <- function(object, bndbox) {
+ srow <- rowFromY(object, bndbox at ymax)
+ if (trunc((ymin(object) - bndbox at ymin)/yres(object)) == (ymin(object) - bndbox at ymin)/yres(object)) {
+ bndbox at ymin <- bndbox at ymin + 0.5 * yres(object)
+ }
+ erow <- rowFromY(object, bndbox at ymin)
+ scol <- colFromX(object, bndbox at xmin)
+ if (trunc((xmax(object) - bndbox at xmax)/xres(object)) == (xmax(object) - bndbox at xmax)/xres(object)) {
+ bndbox at xmax <- bndbox at xmax - 0.5 * xres(object)
+ }
+ ecol <- colFromX(object, bndbox at xmax)
+ cell <- cellFromRowCol(object, srow, scol):cellFromRowCol(object, srow, ecol)
+ if (erow > srow) {
+ # ouch, vectorize, please
+ for (r in (srow+1):erow) {
+ cell2 <- cellFromRowCol(object, r, scol):cellFromRowCol(object, r, ecol)
+ cell <- c(cell, cell2)
+ }
+ }
+ return(cell)
+}
+
setBbox <- function(object, bndbox, keepres=FALSE, snap=FALSE) {
- xrs <- xres(object)
- yrs <- yres(object)
oldbb <- getBbox(object)
bb <- getBbox(bndbox)
@@ -115,18 +135,31 @@
if (abs(bb at ymax - mn) > abs(bb at ymax - mx)) { bb at ymax <- mx } else { bb at ymax <- mn }
}
- object at bbox <- bb
+ newobj <- clearValues(object)
+ newobj at bbox <- bb
+
if (keepres) {
- nc <- as.integer(round( (xmax(object) - xmin(object)) / xrs ))
+ xrs <- xres(object)
+ yrs <- yres(object)
+ nc <- as.integer(round( (xmax(newobj) - xmin(newobj)) / xrs ))
if (nc < 1) { stop( "xmin and xmax are less than one cell apart" )
- } else { object at ncols <- nc }
- nr <- as.integer(round( (ymax(object) - ymin(object)) / xrs ) )
+ } else { newobj at ncols <- nc }
+ nr <- as.integer(round( (ymax(newobj) - ymin(newobj)) / xrs ) )
if (nr < 1) { stop( "ymin and ymax are less than one cell apart" )
- } else { object at nrows <- nr }
- object at bbox@xmax <- object at bbox@xmin + ncol(object) * xrs
- object at bbox@ymax <- object at bbox@ymin + nrow(object) * yrs
+ } else { newobj at nrows <- nr }
+ newobj at bbox@xmax <- newobj at bbox@xmin + ncol(newobj) * xrs
+ newobj at bbox@ymax <- newobj at bbox@ymin + nrow(newobj) * yrs
+
+ if (dataContent(object) == 'all') {
+ indices <- bbIndices(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))
+ }
}
- return(object)
+ return(newobj)
}
Modified: pkg/raster/R/set.values.R
===================================================================
--- pkg/raster/R/set.values.R 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/R/set.values.R 2009-01-23 09:26:46 UTC (rev 176)
@@ -8,14 +8,25 @@
#if (!isGeneric("setValues")) {
# setGeneric("setValues", function(object, values, rownr)
-# standardGeneric("xyValues")) }
+# standardGeneric("setValues")) }
setValues <- function(raster, values, rownr=-1) {
if (!is.vector(values)) {stop('values must be a vector')}
- if (length(values) == 0) { stop('length(values==0). If this is intended then use clearValues(raster)') }
if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {stop('data must be values')}
+
rownr <- round(rownr)
+
+ if (length(values) == 0) {
+ return(clearValues(raster))
+ }
+ if (length(values) == 1) {
+ if (rownr > 0) {
+ values <- rep(values, ncol(raster))
+ } else {
+ values <- rep(values, ncell(raster))
+ }
+ }
if (length(values) == ncell(raster)) {
if (rownr > 0) {
stop("if setting all values, rownr must be < 1")
@@ -44,18 +55,13 @@
clearValues <- function(object) {
- object at data@content <- 'nodata'
- object at data@indices <- ""
if (class(object) == 'RasterLayer') {
- object at data@values <- vector()
+ object <- setRaster(object)
} else {
object at data@values <- matrix(NA,0,0)
}
- if (class(object) == 'RasterLayer') {
- object at data@min <- NA
- object at data@max <- NA
- object at data@haveminmax <- FALSE
- }
+ object at data@content <- 'nodata'
+ object at data@indices <- ""
return(object)
}
Modified: pkg/raster/R/show.R
===================================================================
--- pkg/raster/R/show.R 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/R/show.R 2009-01-23 09:26:46 UTC (rev 176)
@@ -48,9 +48,14 @@
if (object at data@haveminmax) {
cat('min value :' , minValue(object), '\n')
cat('max value :' , maxValue(object), '\n')
- } else { #if (object at data@source == 'disk') {
- cat('min value : NA \n')
- cat('max value : NA \n')
+ } else {
+ if (object at data@source == 'disk') {
+ cat('min value : ? \n')
+ cat('max value : ? \n')
+ } else {
+ cat('min value : \n')
+ cat('max value : \n')
+ }
}
cat('projection :' , projection(object, TRUE), '\n')
cat('xmin :' , xmin(object), '\n')
Modified: pkg/raster/R/standard.generic.functions.R
===================================================================
--- pkg/raster/R/standard.generic.functions.R 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/R/standard.generic.functions.R 2009-01-23 09:26:46 UTC (rev 176)
@@ -33,15 +33,42 @@
}
)
-setMethod('summary', signature(object='RasterLayer'),
- function(object, ...) {
- cat ("Cells: " , ncell(object), '\n')
- if ( dataContent(object) == "all") {
- cat("NAs : ", sum(is.na(values(object))), "\n")
- summary(values(object))
+
+
+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)
+ }
+)
Added: pkg/raster/R/write.R
===================================================================
--- pkg/raster/R/write.R (rev 0)
+++ pkg/raster/R/write.R 2009-01-23 09:26:46 UTC (rev 176)
@@ -0,0 +1,57 @@
+
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,1
+# Licence GPL v3
+
+
+
+
+rasterWriteFormats <- function() {
+ gd <- gdalDrivers()
+ gd <- as.matrix(subset(gd, gd[,3] == T))
+ short <- c("raster", "ascii", as.vector(gd[,1]))
+ long <- c("raster package format", "Arc ascii", as.vector(gd[,2]))
+ m <- cbind(short, long)
+ colnames(m) <- c("name", "long_name")
+ return(m)
+}
+
+
+.isSupportedGDALFormat <- function(dname) {
+ gd <- gdalDrivers()
+ gd <- as.matrix(subset(gd, gd[,3] == T))
+ res <- dname %in% gd
+ if (!res) { stop(paste(dname, "is not a supported file format. See rasterWriteFormats()" ) ) }
+ return(res)
+}
+
+
+
+writeRaster <- function(raster, format='raster', overwrite=FALSE) {
+
+ if (dataContent(raster) != 'row' & dataContent(raster) != 'all' & dataContent(raster) != 'sparse' ) {
+ stop('First use setValues()')
+ }
+
+ if (format=='raster') {
+ if (dataContent(raster) == 'row' ) {
+ raster <- .writeRasterRow(raster, overwrite=overwrite)
+ } else {
+ raster <- .writeRasterAll(raster, overwrite=overwrite)
+ }
+ } else if (format=='ascii') {
+ raster <- .writeAscii(raster, overwrite=overwrite)
+ } else {
+ .isSupportedGDALFormat(format)
+ if (dataContent(raster) == 'row' ) {
+ raster <- .writeGDALrow(raster, format, overwrite, ForceIntOutput=FALSE, mvFlag=NA, options=NULL)
+ } else {
+ raster <- .writeGDALall(raster, format, overwrite, ForceIntOutput=FALSE, mvFlag=NA, options=NULL)
+ }
+ }
+ return(raster)
+}
+
+
Modified: pkg/raster/R/writeRaster.R
===================================================================
--- pkg/raster/R/writeRaster.R 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/R/writeRaster.R 2009-01-23 09:26:46 UTC (rev 176)
@@ -5,57 +5,6 @@
# Licence GPL v3
-
-rasterFormats <- function() {
- gd <- gdalDrivers()
- gd <- as.matrix(subset(gd, gd[,3] == T))
- short <- c("raster", "ascii", as.vector(gd[,1]))
- long <- c("raster package format", "Arc ascii", as.vector(gd[,2]))
- m <- cbind(short, long)
- colnames(m) <- c("name", "long_name")
- return(m)
-}
-
-
-.isSupportedGDALFormat <- function(dname) {
- gd <- gdalDrivers()
- gd <- as.matrix(subset(gd, gd[,3] == T))
- res <- dname %in% gd
- if (!res) { stop(paste(dname, "is not a supported file format. See rasterFormats()" ) ) }
- return(res)
-}
-
-
-
-writeRaster <- function(raster, format='raster', overwrite=FALSE) {
-
- if (dataContent(raster) != 'row' & dataContent(raster) != 'all' & dataContent(raster) != 'sparse' ) {
- stop('First use setValues()')
- }
-
- if (format=='raster') {
- if (dataContent(raster) == 'row' ) {
- raster <- .writeRasterRow(raster, overwrite=overwrite)
- } else {
- raster <- .writeRasterAll(raster, overwrite=overwrite)
- }
- } else if (format=='ascii') {
- raster <- .writeAscii(raster, overwrite=overwrite)
- } else {
- .isSupportedGDALFormat(format)
- if (dataContent(raster) == 'row' ) {
- raster <- .writeGDALrow(raster, format, overwrite, ForceIntOutput=FALSE, mvFlag=NA, options=NULL)
- } else {
- raster <- .writeGDALall(raster, format, overwrite, ForceIntOutput=FALSE, mvFlag=NA, options=NULL)
- }
- }
- return(raster)
-}
-
-
-
-
-
.setFileExtensionValues <- function(fname) {
fname <- setFileExtension(fname, ".gri")
return(fname)
Modified: pkg/raster/man/write.Rd
===================================================================
--- pkg/raster/man/write.Rd 2009-01-22 14:06:37 UTC (rev 175)
+++ pkg/raster/man/write.Rd 2009-01-23 09:26:46 UTC (rev 176)
@@ -1,7 +1,7 @@
\name{write}
\alias{writeRaster}
-\alias{rasterFormats}
+\alias{rasterWriteFormats}
\title{Write raster data to a file}
@@ -12,7 +12,7 @@
\usage{
writeRaster(raster, format='raster', overwrite=FALSE)
- rasterFormats()
+ rasterWriteFormats()
}
\arguments{
@@ -25,21 +25,36 @@
Values in a \code{RasterLayer} object are written to a file. Relatively small datasets can be loaded into memory, manipulated, and saved to disk in their entirety.
Large datasets can be read and written row by row.
When writing by row, you must write all rows, and you must write them in sequence. Start at row=1, and end at row=nrow(raster). You cannot overwrite a single row in an existing raster file.
- rasterFormats returns a matrix of the file formats (the "drivers") that are supported.
+ rasterWriteFormats returns a matrix of the file formats (the "drivers") that are supported.
Supported formats include
- \item{Format}{Long name}
- \item{raster}{'Native' raster package format}
- \item{ascii}{Arc Ascii format}
- \item{ENVI}{ENVI .hdr Labelled}
- \item{EHdr}{ESRI .hdr Labelled}
- \item{ERS}{ERMapper .ers Labelled}
- \item{GTiff}{GeoTiff}
- \item{HFA}{Erdas Imagine Images (.img)}
- \item{ILWIS}{ILWIS Raster Map}
- \item{PAux}{PCI .aux Labelled}
- \item{PCIDSK}{PCIDSK Database File}
- \item{RST}{Idrisi Raster A.1}
+Format
+ Long name
+
+raster
+ 'Native' raster package format
+
+ascii
+ Arc Ascii format
+
+ ENVI ENVI .hdr Labelled
+
+ EHdr ESRI .hdr Labelled
+
+ ERS ERMapper .ers Labelled
+
+ GTiff GeoTiff
+
+ HFAErdas Imagine Images (.img)
+
+ ILWIS ILWIS Raster Map
+
+ PAux PCI .aux Labelled
+
+ PCIDSK PCIDSK Database File
+
+ RST Idrisi Raster A.1
+
}
\author{Robert J. Hijmans \email{r.hijmans at gmail.com}}
More information about the Raster-commits
mailing list