[Raster-commits] r326 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 8 09:03:14 CET 2009
Author: rhijmans
Date: 2009-03-08 09:03:14 +0100 (Sun, 08 Mar 2009)
New Revision: 326
Added:
pkg/raster/R/dataProperties.R
pkg/raster/R/showTrack.R
pkg/raster/R/stackRead.R
pkg/raster/R/xyProperties.R
pkg/raster/man/stack.Rd
Removed:
pkg/raster/man/stack-methods.Rd
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/Artith.R
pkg/raster/R/Compare_Logical.R
pkg/raster/R/Math.R
pkg/raster/R/Merge.R
pkg/raster/R/aggregate.R
pkg/raster/R/all.classes.R
pkg/raster/R/bilinearValue.R
pkg/raster/R/calc.R
pkg/raster/R/calcStack.R
pkg/raster/R/canProcessInMemory.R
pkg/raster/R/cellStats.R
pkg/raster/R/cover.R
pkg/raster/R/crop.R
pkg/raster/R/disaggregate.R
pkg/raster/R/expand.R
pkg/raster/R/export.R
pkg/raster/R/filenames.R
pkg/raster/R/init.R
pkg/raster/R/linesToRaster.R
pkg/raster/R/na.R
pkg/raster/R/neighborhood.R
pkg/raster/R/overlay.R
pkg/raster/R/pointsToRaster.R
pkg/raster/R/polygonToRaster.R
pkg/raster/R/project.R
pkg/raster/R/properties.R
pkg/raster/R/read.raster.R
pkg/raster/R/reclass.R
pkg/raster/R/replacement.R
pkg/raster/R/replacement2.R
pkg/raster/R/resample.R
pkg/raster/R/setDatatype.R
pkg/raster/R/setMinMax.R
pkg/raster/R/singleIndex.R
pkg/raster/R/summary.R
pkg/raster/R/writeGDAL.R
pkg/raster/R/writeRaster.R
pkg/raster/R/xyValues.R
pkg/raster/man/LinesToRaster.Rd
pkg/raster/man/PolygonsToRaster.Rd
pkg/raster/man/map.Rd
pkg/raster/man/misc.Rd
pkg/raster/man/pointsToRaster.Rd
pkg/raster/man/properties.Rd
pkg/raster/man/rasterToPoints.Rd
pkg/raster/man/round.Rd
pkg/raster/man/saveStack.Rd
pkg/raster/man/writeadvanced.Rd
pkg/raster/man/xyValues.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/DESCRIPTION 2009-03-08 08:03:14 UTC (rev 326)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.9-4
-Date: 7-March-2009
+Version: 0.8.9-5
+Date: 8-March-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/Artith.R
===================================================================
--- pkg/raster/R/Artith.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/Artith.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -9,7 +9,7 @@
setMethod("Arith", signature(e1='RasterLayer', e2='RasterLayer'),
function(e1, e2){
if ( compare(c(e1, e2)) ) {
- if (.CanProcessInMemory(e1, 4)) {
+ if (canProcessInMemory(e1, 4)) {
raster <- setRaster(e1, values=callGeneric( as.numeric(.getRasterValues(e1)), .getRasterValues(e2)))
} else {
raster <- setRaster(e1, filename=tempfile())
@@ -29,7 +29,7 @@
setMethod("Arith", signature(e1='RasterLayer', e2='numeric'),
function(e1, e2){
- if (.CanProcessInMemory(e1, 4)) {
+ if (canProcessInMemory(e1, 4)) {
return(setRaster(e1, values=callGeneric(as.numeric(.getRasterValues(e1)), e2) ) )
} else {
raster <- setRaster(e1, filename=tempfile())
@@ -47,7 +47,7 @@
setMethod("Arith", signature(e1='numeric', e2='RasterLayer'),
function(e1, e2){
- if (.CanProcessInMemory(e2, 4)) {
+ if (canProcessInMemory(e2, 4)) {
return(setRaster(e2, values=callGeneric(as.numeric(e1), .getRasterValues(e2))))
} else {
raster <- setRaster(e2, filename=tempfile())
Modified: pkg/raster/R/Compare_Logical.R
===================================================================
--- pkg/raster/R/Compare_Logical.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/Compare_Logical.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -42,11 +42,11 @@
setMethod('!', signature(x='RasterLayer'),
function(x){
- if (.CanProcessInMemory(x, 3)) {
+ if (canProcessInMemory(x, 3)) {
return(setValues(x, !values(x)))
} else {
raster <- setRaster(x, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
for (r in 1:nrow(x)) {
raster <- setValues(raster, !.getRowValues(x, r), r)
raster <- writeRaster(raster)
@@ -63,13 +63,12 @@
if (!isTRUE(is.atomic(e2) & length(e2)==1)) {
stop('second argument should be a single number')
}
- if (.CanProcessInMemory(e1, 3)) {
- raster <- setRaster(e1)
- raster <- setDatatype(raster, datatype='LOGICAL')
+ raster <- setRaster(e1)
+ raster <- setDatatype(raster, 'LOG1S')
+ if (canProcessInMemory(e1, 3)) {
raster <- setValues(raster, values=callGeneric(.getRasterValues(e1), rep(e2, ncell(e1)) ) )
} else {
- raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setFilename(raster, filename=tempfile())
rowrep <- rep(e2, ncol(e1))
for (r in 1:nrow(e1)) {
raster <- setValues(raster, callGeneric( .getRowValues(e1, r), rowrep ), r)
@@ -87,13 +86,13 @@
if (!isTRUE(is.atomic(e1) & length(e1)==1)) {
stop('first argument should be a single number')
}
- if (.CanProcessInMemory(e2, 3)) {
+ if (canProcessInMemory(e2, 3)) {
raster <- setRaster(e2)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
raster <- setValues(raster, callGeneric(.getRasterValues(e2), rep(e1, ncell(e2)) ) )
} else {
raster <- setRaster(e2, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
rowrep <- rep(e1, ncol(e2))
for (r in 1:nrow(e2)) {
raster <- setValues(raster, callGeneric( .getRowValues(e2, r), rowrep ), r)
@@ -110,13 +109,12 @@
if (!cond) {
stop("Cannot compare RasterLayers that have different BasicRaster attributes. See compare()")
}
- if (.CanProcessInMemory(e1, 3)) {
- raster <- setRaster(e1)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setRaster(e1)
+ raster <- setDatatype(raster, 'LOG1S')
+ if (canProcessInMemory(e1, 3)) {
raster <- setValues(raster, callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) )
} else {
- raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setFilename(raster, filename=tempfile())
for (r in 1:nrow(e1)) {
raster <- setValues(raster, callGeneric( .getRowValues(e1, r), .getRowValues(e2, r) ), r)
raster <- writeRaster(raster)
@@ -133,13 +131,12 @@
setMethod("Logic", signature(e1='RasterLayer', e2='RasterLayer'),
function(e1, e2){
if ( compare(c(e1, e2)) ) {
- if (.CanProcessInMemory(e1, 3)) {
- raster <- setRaster(e1)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setRaster(e1)
+ raster <- setDatatype(raster, 'LOG1S')
+ if (canProcessInMemory(e1, 3)) {
raster <- setValues(raster, callGeneric(.getLogicalValues(e1), .getLogicalValues(e2)))
} else {
- raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setFilename(raster, filename=tempfile())
for (r in 1:nrow(e1)) {
raster <- setValues(raster, callGeneric( .getLogicalRowValues(e1, r), .getLogicalRowValues(e2, r) ), r)
raster <- writeRaster(raster)
Modified: pkg/raster/R/Math.R
===================================================================
--- pkg/raster/R/Math.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/Math.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -10,7 +10,7 @@
fname <- as.character(sys.call(sys.parent())[[1]])
- if (.CanProcessInMemory(x, 3)) {
+ if (canProcessInMemory(x, 3)) {
raster <- setRaster(x, values=callGeneric(.getRasterValues(x)))
if (fname %in% c('floor', 'ceiling', 'trunc')) {
raster <- setDatatype(raster, 'INT4S')
@@ -36,7 +36,7 @@
setMethod("Math2", signature(x='RasterLayer'),
function (x, digits=0) {
digits <- max(0, digits)
- if (.CanProcessInMemory(x, 3)) {
+ if (canProcessInMemory(x, 3)) {
x <- setValues(x, callGeneric(values(x), digits))
if (digits == 0) {
x <- setDatatype(x, 'INT4S')
Modified: pkg/raster/R/Merge.R
===================================================================
--- pkg/raster/R/Merge.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/Merge.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -29,7 +29,8 @@
isint <- TRUE
for (i in 1:length(rasters)) {
- if (rasters[[i]]@file at datatype != 'integer') {
+ dtype <- .shortDataType(rasters[[i]]@file at datanotation)
+ if (dtype != 'INT') {
isInt <- FALSE
}
}
@@ -48,7 +49,7 @@
v <- vector(length=0)
- if (!.CanProcessInMemory(x, 2) && filename == '') {
+ if (!canProcessInMemory(x, 2) && filename == '') {
filename <- tempfile()
outraster <- setFilename(outraster, filename )
if (options('verbose')[[1]]) { cat('writing raster to:', filename(raster)) }
@@ -84,12 +85,7 @@
v <- c(v, rd)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outraster) == '') {
Modified: pkg/raster/R/aggregate.R
===================================================================
--- pkg/raster/R/aggregate.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/aggregate.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -59,7 +59,7 @@
}
} else if ( dataSource(x) == 'disk') {
- if (!.CanProcessInMemory(x, 3) && filename == '') {
+ if (!canProcessInMemory(x, 3) && filename == '') {
filename <- tempfile()
outraster <- setFilename(outraster, filename )
if (options('verbose')[[1]]) { cat('writing raster to:', filename(raster)) }
@@ -97,12 +97,8 @@
outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype, datatype=datatype)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
+
}
if (filename(outRaster) == "") {
outRaster <- setValues(outRaster, v)
Modified: pkg/raster/R/all.classes.R
===================================================================
--- pkg/raster/R/all.classes.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/all.classes.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -64,9 +64,9 @@
shortname ='character', # short name
driver ='character', #gdal, raster
gdalhandle='list',
- datatype ='character', #'numeric' or 'integer'
- datasize ='integer',
- datasigned='logical',
+# datatype ='character', #'numeric' or 'integer'
+# datasize ='integer',
+# datasigned='logical',
datanotation='character',
byteorder ='character',
nodatavalue ='numeric', # on disk, in ram it is NA
@@ -79,9 +79,9 @@
shortname ='',
driver = 'raster',
gdalhandle= list(),
- datatype = 'numeric',
- datasize = as.integer(4),
- datasigned= TRUE,
+# datatype = 'numeric',
+# datasize = as.integer(4),
+# datasigned= TRUE,
datanotation='FLT4S',
byteorder = .Platform$endian,
nodatavalue = -9999,
@@ -90,6 +90,8 @@
bandorder = 'BIL'
),
validity = function(object) {
+ c1 <- datanotation %in% c('LOG1S', 'INT1S', 'INT2S', 'INT4S', 'INT8S', 'INT1U', 'INT2U', 'INT4U', 'INT8U', 'FLT4S', 'FLT8S')
+ return(c1)
}
)
@@ -119,21 +121,37 @@
}
)
+
+
+setClass ('RasterLegend',
+ representation (
+ type = 'character',
+ begin = 'vector',
+ end = 'vector',
+ color = 'vector'
+ ),
+ prototype (
+ )
+ )
+
+
setClass ('RasterLayer',
contains = 'Raster',
representation (
title = 'character',
file = 'RasterFile',
data = 'SingleLayerData',
+ legend = 'RasterLegend',
history = 'vector'
),
prototype (
history = vector(mode='character')
)
)
-
+
+
setClass('MultipleRasterData',
representation (
values='matrix',
Modified: pkg/raster/R/bilinearValue.R
===================================================================
--- pkg/raster/R/bilinearValue.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/bilinearValue.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -51,13 +51,8 @@
}
-if (!isGeneric("bilinearValue")) {
- setGeneric("bilinearValue", function(raster, xyCoords)
- standardGeneric("bilinearValue"))
-}
-setMethod("bilinearValue", signature(raster='RasterLayer', xyCoords='matrix'),
-function(raster, xyCoords) {
+.bilinearValue <- function(raster, xyCoords) {
four <- .fourCellsFromXY(raster, xyCoords)
xy4 <- matrix(xyFromCell(raster, as.vector(four)), ncol=8)
x1 <- apply(xy4[,1:4,drop=FALSE], 1, min)
@@ -69,6 +64,6 @@
v <- matrix(cellValues(raster, cells), ncol=4)
return( .bilinear(xyCoords[,1], xyCoords[,2], x1, x2, y1, y2, v[,1], v[,2], v[,3], v[,4]) )
}
-)
+
Modified: pkg/raster/R/calc.R
===================================================================
--- pkg/raster/R/calc.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/calc.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -33,7 +33,7 @@
outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
}
} else if (dataSource(x) == 'disk') {
- if (!.CanProcessInMemory(x, 3) & filename == '') {
+ if (!canProcessInMemory(x, 3) & filename == '') {
filename <- tempfile()
outraster <- setFilename(outraster, filename )
}
@@ -48,12 +48,7 @@
outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(x) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outraster) == "") {
Modified: pkg/raster/R/calcStack.R
===================================================================
--- pkg/raster/R/calcStack.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/calcStack.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -22,7 +22,7 @@
}
} else {
starttime <- proc.time()
- if (!.CanProcessInMemory(x, 4) & filename == '') {
+ if (!canProcessInMemory(x, 4) & filename == '') {
filename=tempfile()
outraster <- setFilename(outraster, filename )
}
@@ -36,12 +36,7 @@
outraster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(x) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outraster) == "") {
Modified: pkg/raster/R/canProcessInMemory.R
===================================================================
--- pkg/raster/R/canProcessInMemory.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/canProcessInMemory.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -5,7 +5,7 @@
# Licence GPL v3
-.CanProcessInMemory <- function(raster, n=4) {
+canProcessInMemory <- function(raster, n=4) {
gc()
if (ncell(raster) > 2147483647) {
Modified: pkg/raster/R/cellStats.R
===================================================================
--- pkg/raster/R/cellStats.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/cellStats.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -21,7 +21,7 @@
if (dataSource(x) == 'ram') {
stop('no values associated with this RasterLayer')
}
- if (.CanProcessInMemory(x, 2)) {
+ if (canProcessInMemory(x, 2)) {
x <- readAll(x)
}
}
Modified: pkg/raster/R/cover.R
===================================================================
--- pkg/raster/R/cover.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/cover.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -35,7 +35,7 @@
stop('values for y are not available')
}
- if (!.CanProcessInMemory(x, 4) && filename == '') {
+ if (!canProcessInMemory(x, 4) && filename == '') {
filename <- tempfile()
outraster <- setFilename(outraster, filename )
if (options('verbose')[[1]]) { cat('writing raster to:', filename(raster)) }
@@ -55,12 +55,7 @@
outRaster <- writeRaster(outRaster, filetype=filetype, overwrite=overwrite)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outRaster) == "") {
Modified: pkg/raster/R/crop.R
===================================================================
--- pkg/raster/R/crop.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/crop.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -44,12 +44,7 @@
}
rownr <- rownr + 1
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /rownr
- ttg <- round(tpr/60 * (nrow(raster) - rownr), digits=1)
- cat('row', rownr, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outraster) == '') {
outraster <- setValues(outraster, v)
Added: pkg/raster/R/dataProperties.R
===================================================================
--- pkg/raster/R/dataProperties.R (rev 0)
+++ pkg/raster/R/dataProperties.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -0,0 +1,38 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : October 2008
+# Version 0.8
+# Licence GPL v3
+
+#dataSize <- function(object) {return(object at file@datasize)}
+dataSize <- function(object) {
+ if (class(object) != 'character'){object <- dataType(object)}
+ return( as.integer (substr(object, 4, 4)) )
+}
+
+dataSigned <- function(object) {
+ if (class(object) != 'character'){object <- dataType(object)}
+ ifelse(substr(object, 5, 5) == 'U', FALSE, TRUE )
+}
+
+.shortDataType <- function(object) {
+ if (class(object) != 'character'){object <- dataType(object)}
+ return( substr(object, 1, 3))
+}
+
+
+dataType <- function(object) {
+ return(object at file@datanotation)
+}
+
+dataContent <- function(object) {
+ return(object at data@content)
+}
+
+dataIndices <- function(object) {
+ return(object at data@indices)
+}
+
+dataSource <- function(object) {
+ return(object at data@source)
+}
Modified: pkg/raster/R/disaggregate.R
===================================================================
--- pkg/raster/R/disaggregate.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/disaggregate.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -55,12 +55,7 @@
outraster <- setValues(outraster, v)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
return(outraster)
}
Modified: pkg/raster/R/expand.R
===================================================================
--- pkg/raster/R/expand.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/expand.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -44,7 +44,7 @@
}
} else if ( dataSource(raster) == 'disk' ) {
- if (!.CanProcessInMemory(outraster, 4) && filename == '') {
+ if (!canProcessInMemory(outraster, 4) && filename == '') {
filename <- tempfile()
outraster <- setFilename(outraster, filename )
if (options('verbose')[[1]]) { cat('writing raster to:', filename(raster)) }
@@ -68,12 +68,7 @@
v <- c(v, d)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outraster) == '') {
Modified: pkg/raster/R/export.R
===================================================================
--- pkg/raster/R/export.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/export.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -32,15 +32,24 @@
cat("NROWS ", nrow(raster), "\n", file = thefile)
cat("NCOLS ", ncol(raster), "\n", file = thefile)
cat("NBANDS ", nbands(raster), "\n", file = thefile)
- cat("NBITS ", raster at file@datasize * 8, "\n", file = thefile)
+ cat("NBITS ", dataSize(raster at file@datanotation) * 8, "\n", file = thefile)
if (.Platform$endian == "little") { btorder <- "I"
} else { btorder <- "M" }
cat("BYTEORDER ", btorder, "\n", file = thefile)
# PIXELTYPE should work for Gdal, and perhpas ArcGIS, see:
# http://lists.osgeo.org/pipermail/gdal-dev/2006-October/010416.html
- if (raster at file@datatype == 'integer') { pixtype <- "SIGNEDINT"
- } else { pixtype <- "FLOAT" }
+
+ dtype <- .shortDataType(raster at file@datanotation)
+ if (dtype == 'INT' | dtype == 'LOG' ) {
+ if (dataSigned(raster at file@datanotation)) {
+ pixtype <- "SIGNEDINT"
+ } else {
+ pixtype <- "INT"
+ }
+ } else {
+ pixtype <- "FLOAT"
+ }
cat("PIXELTYPE ", pixtype, "\n", file = thefile)
cat("LAYOUT ", "BIL", "\n", file = thefile)
cat("SKIPBYTES 0\n", file = thefile)
@@ -48,7 +57,7 @@
cat("ULYMAP", ymax(raster) - 0.5 * yres(raster), "\n", file = thefile)
cat("XDIM", xres(raster), "\n", file = thefile)
cat("YDIM", yres(raster), "\n", file = thefile)
- browbytes <- round(ncol(raster) * raster at file@datasize)
+ browbytes <- round(ncol(raster) * dataSize(raster at file@datanotation) )
cat("BANDROWBYTES ", browbytes, "\n", file = thefile)
cat("TOTALROWBYTES ", browbytes * nbands(raster), "\n", file = thefile)
cat("BANDGAPBYTES 0", "\n", file = thefile)
@@ -78,9 +87,12 @@
cat("WIDTH ", ncol(raster), "\n", file = thefile)
cat("NUM_LAYERS ", nbands(raster), "\n", file = thefile)
- if (raster at file@datatype == 'integer') { dd <- "S"
- } else { dd <- "F" }
- nbits <- raster at file@datasize * 8
+ if (.shortDataType(raster at file@datanotation) == 'INT') {
+ dd <- "S"
+ } else {
+ dd <- "F"
+ }
+ nbits <- dataSize(raster at file@datanotation) * 8
dtype <- paste(dd, nbits, sep="")
cat("DATA_TYPE ", dtype, "\n", file = thefile)
#U1, U2, U4, U8, U16, U32
@@ -134,16 +146,17 @@
cat("bands = ", raster at file@nbands, "\n", file = thefile)
cat("header offset = 0\n", file = thefile)
cat("file type = ENVI Standard\n", file = thefile)
- if (raster at file@datatype == 'integer') {
- if (raster at file@datasize == 1) { dtype <- 1
- } else if (raster at file@datasize == 2) { dtype <- 2
- } else if (raster at file@datasize == 4) { dtype <- 3
- } else if (raster at file@datasize == 8) { dtype <- 14
+ dsize <- dataSize(raster at file@datanotation)
+ if (.shortDataType(raster at file@datanotation) == 'INT') {
+ if (dsize == 1) { dtype <- 1
+ } else if (dsize == 2) { dtype <- 2
+ } else if (dsize == 4) { dtype <- 3
+ } else if (dsize == 8) { dtype <- 14
} else { stop('what?')
}
} else {
- if (raster at file@datasize == 4) { dtype <- 4
- } else if (raster at file@datasize == 8) { dtype <- 5
+ if (dsize == 4) { dtype <- 4
+ } else if (dsize == 8) { dtype <- 5
} else { stop('what?')
}
}
Modified: pkg/raster/R/filenames.R
===================================================================
--- pkg/raster/R/filenames.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/filenames.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -3,14 +3,14 @@
# International Rice Research Institute
# contact: r.hijmans at gmail.com
# Date : October 2008
-# Version 0,8
+# Version 0.8
# Licence GPL v3
-trim <- function(astring) {
+trim <- function(x) {
f <- function(s) {return( gsub('^[[:space:]]+', '', gsub('[[:space:]]+$', '', s) ) )}
- return(unlist(lapply(astring, f)))
-}
+ return(unlist(lapply(x, f)))
+}
shortFileName <- function(filename) {
Modified: pkg/raster/R/init.R
===================================================================
--- pkg/raster/R/init.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/init.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -29,12 +29,9 @@
outraster <- setValues(outraster, fun(n), r)
outraster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+
+ if (r %in% track) { .showTrack(r, track, starttime) }
+
}
if (filename(outraster) == "") {
outraster <- setValues(outraster, v)
Modified: pkg/raster/R/linesToRaster.R
===================================================================
--- pkg/raster/R/linesToRaster.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/linesToRaster.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -196,12 +196,7 @@
raster <- writeRaster(raster, filetype=filetype)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename == "") {
Modified: pkg/raster/R/na.R
===================================================================
--- pkg/raster/R/na.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/na.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -8,7 +8,7 @@
setMethod("is.na", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
return(setValues(raster, is.na(.getRasterValues(x))))
}
)
@@ -16,7 +16,7 @@
setMethod("is.nan", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
return(setValues(raster, is.nan(.getRasterValues(x))))
}
)
@@ -24,7 +24,7 @@
setMethod("is.infinite", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
return(setValues(raster, values=is.infinite(.getRasterValues(x))))
}
)
@@ -32,7 +32,7 @@
setMethod("is.finite", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, 'LOGICAL')
+ raster <- setDatatype(raster, 'LOG1S')
return(setValues(raster, values=is.finite(.getRasterValues(x))))
}
)
Modified: pkg/raster/R/neighborhood.R
===================================================================
--- pkg/raster/R/neighborhood.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/neighborhood.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -77,12 +77,7 @@
rr <- rr + 1
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
Modified: pkg/raster/R/overlay.R
===================================================================
--- pkg/raster/R/overlay.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/overlay.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -68,7 +68,7 @@
} else {
if (filename(outraster) == "") {
- if (!.CanProcessInMemory(outraster, 4)) {
+ if (!canProcessInMemory(outraster, 4)) {
filename <- tempfile()
outraster <- setFilename(outraster, filename )
} else {
@@ -104,12 +104,7 @@
outraster <- writeRaster(outraster, filetype=filetype, overwrite=overwrite)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(x) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename(outraster) == "") {
Modified: pkg/raster/R/pointsToRaster.R
===================================================================
--- pkg/raster/R/pointsToRaster.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/pointsToRaster.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -5,10 +5,9 @@
# Licence GPL v3
-pointsToRaster <- function(raster, xy, values=rep(1, length(xy[,1])), fun=length, filename="", overwrite=FALSE) {
+pointsToRaster <- function(raster, xy, values=rep(1, length(xy[,1])), fun=length, background=NA, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
# make this an argument ? so that you can use e.g. background=0
- background=NA
-
+
if (class(xy) != 'matrix') {
stop('xy must be a matrix')
}
@@ -17,6 +16,8 @@
}
rs <- setRaster(raster, filename)
+ rs <- setDatatype(rs, datatype)
+
cells <- cellFromXY(rs, xy)
rows <- rowFromCell(rs, cells)
cols <- colFromCell(rs, cells)
@@ -26,30 +27,29 @@
dna <- vector(length=ncol(rs))
dna[] <- background
v <- vector(length=0)
+
+ starttime <- proc.time()
+
for (r in 1:rs at nrows) {
+ d <- dna
if (r %in% urows) {
ss <- subset(xyarc, xyarc[,4] == r)
ucols <- unique(ss[,5])
# ucols <- ucols[order(ucols)]
- d <- dna
for (c in 1:length(ucols)) {
sss <- subset(ss, ss[,5] == ucols[c] )
d[ucols[c]] <- fun(sss[,3])
}
- if (filename != "") {
- rs <- setValues(rs, d, r)
- rs <- writeRaster(rs)
- } else {
- v <- c(v, d)
- }
+ }
+ if (filename != "") {
+ rs <- setValues(rs, d, r)
+ rs <- writeRaster(rs, overwrite=overwrite, filetype=filetype)
} else {
- if (filename != "") {
- rs <- setValues(rs, dna, r)
- rs <- writeRaster(rs, r)
- } else {
- v <- c(v, dna)
- }
- }
+ v <- c(v, d)
+ }
+
+ if (r %in% track) { .showTrack(r, track, starttime) }
+
}
if (filename == "") {
rs <- setValues(rs, v)
Modified: pkg/raster/R/polygonToRaster.R
===================================================================
--- pkg/raster/R/polygonToRaster.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/polygonToRaster.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -60,7 +60,7 @@
-polygonsToRaster <- function(spPolys, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA", filetype='raster', datatype='FLT4S', track=c(100, 500, 1:(round(nrow(raster)/1000)) * 1000)) {
+polygonsToRaster <- function(spPolys, raster, field=0, updateRaster=FALSE, updateValue="NA", filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S', track=-1) {
filename <- trim(filename)
starttime <- proc.time()
@@ -207,11 +207,7 @@
raster <- writeRaster(raster, overwrite=overwrite, filetype=filetype)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- round((elapsed /r), digits=2)
- print(paste('row', r, '--', tpr, 'seconds/row --', nrow(raster)+1-r, " rows to go"))
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
}
if (filename == "") {
Modified: pkg/raster/R/project.R
===================================================================
--- pkg/raster/R/project.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/project.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -53,7 +53,7 @@
inMemory <- filename(to) == ""
v <- vector(length=0)
- if (!.CanProcessInMemory(to, 1) && filename(to) == '') {
+ if (!canProcessInMemory(to, 1) && filename(to) == '') {
filename <- tempfile()
to <- setFilename(to, filename )
if (options('verbose')[[1]]) { cat('writing raster to:', filename(to)) }
@@ -76,7 +76,7 @@
if (method=='ngb') {
vals <- xyValues(from, xy)
} else {
- vals <- bilinearValue(from, xy)
+ vals <- xyValues(from, xy, method='bilinear')
}
vals <- xyValues(from, unProjXY)
@@ -87,12 +87,8 @@
to <- writeRaster(to, overwrite=overwrite)
}
- if (r %in% track) {
- elapsed <- (proc.time() - starttime)[3]
- tpr <- elapsed /r
- ttg <- round(tpr/60 * (nrow(raster) - r), digits=1)
- cat('row', r, '-', ttg, 'minutes to go\n')
- }
+ if (r %in% track) { .showTrack(r, track, starttime) }
+
}
if (inMemory) {
to <- setValues(to, v)
Modified: pkg/raster/R/properties.R
===================================================================
--- pkg/raster/R/properties.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/properties.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -13,40 +13,6 @@
return(object at file@name)
}
-xmin <- function(object) {
- object <- getBbox(object)
- return(as.numeric(object at xmin))
-}
-
-xmax <- function(object) {
- object <- getBbox(object)
- return(as.numeric(object at xmax))
-}
-
-ymin <- function(object) {
- object <- getBbox(object)
- return(as.numeric( object at ymin))
-}
-
-ymax <- function(object) {
- object <- getBbox(object)
- return(as.numeric(object at ymax))
-}
-
-xres <- function(object) {
- return ( as.numeric( (xmax(object) - xmin(object)) / ncol(object)) )
-}
-
-yres <- function(object) {
- return ( as.numeric( (ymax(object) - ymin(object)) / nrow(object)) )
-}
-
-resolution <- function(object) {
- return(c(xres(object), yres(object)))
-}
-
-
-
band <- function(object) {
if (class(object) == "RasterLayer") {
return(object at file@band)
@@ -82,13 +48,7 @@
-origin <- function(object) {
- x <- xmin(object) - xres(object)*(round(xmin(object) / xres(object)))
- y <- ymax(object) - yres(object)*(round(ymax(object) / yres(object)))
- return(c(x, y))
-}
-
minValue <- function(object, layer=1) {
if (layer < 1) {
return(NA)
@@ -106,27 +66,6 @@
}
-dataContent <- function(object) {
- return(object at data@content)
-}
-
-dataIndices <- function(object) {
- return(object at data@indices)
-}
-
-dataSource <- function(object) {
- return(object at data@source)
-}
-
-dataType <- function(object) {
- return(object at file@datanotation)
-}
-
-
-dataSize <- function(object) {
- return(object at file@datasize)
-}
-
.driver <- function(object) {
return(object at file@driver)
}
Modified: pkg/raster/R/read.raster.R
===================================================================
--- pkg/raster/R/read.raster.R 2009-03-07 15:49:30 UTC (rev 325)
+++ pkg/raster/R/read.raster.R 2009-03-08 08:03:14 UTC (rev 326)
@@ -2,7 +2,7 @@
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
# Date : June 2008
-# Version 0,4
+# Version 0.8
# Licence GPL v3
@@ -66,18 +66,21 @@
stop(paste(filename(raster)," does not exist"))
}
con <- file(rastergri, "rb")
- if (raster at file@datatype == "ascii") {
- stop("this type of ascii raster is not supported yet")
- } else if (raster at file@datatype == "integer" | raster at file@datatype == "logical" ) {
+
+ dtype <- .shortDataType(raster at file@datanotation)
+ if (dtype == "INT" | dtype == "LOG" ) {
dtype <- "integer"
- } else {
+ } else {
dtype <- "numeric"
}
+ dsize <- dataSize(raster at file@datanotation)
+ dsign <- dataSigned(raster at file@datanotation)
+
if (rownr > 0) {
- seek(con, ((rownr-1) * ncol(raster) + (startcol-1)) * raster at file@datasize)
- result <- readBin(con, what=dtype, n=ncolumns, size=raster at file@datasize, signed=raster at file@datasigned, endian=raster at file@byteorder) }
+ seek(con, ((rownr-1) * ncol(raster) + (startcol-1)) * dsize)
+ result <- readBin(con, what=dtype, n=ncolumns, dsize, dsign, endian=raster at file@byteorder) }
else {
- result <- readBin(con, what=dtype, n=ncell(raster), size=raster at file@datasize, signed=raster at file@datasigned, endian=raster at file@byteorder)
+ result <- readBin(con, what=dtype, n=ncell(raster), dsize, dsign, endian=raster at file@byteorder)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 326
More information about the Raster-commits
mailing list