[Raster-commits] r272 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 11 10:33:48 CET 2009
Author: rhijmans
Date: 2009-02-11 10:33:47 +0100 (Wed, 11 Feb 2009)
New Revision: 272
Added:
pkg/raster/R/clearValues.R
pkg/raster/R/mCalc.R
pkg/raster/R/makeSparse.R
pkg/raster/R/setValues.R
Removed:
pkg/raster/R/set.values.R
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/Merge.R
pkg/raster/R/aggregate.R
pkg/raster/R/calc.R
pkg/raster/R/compare.logical.functions.R
pkg/raster/R/depracated.R
pkg/raster/R/linesToRaster.R
pkg/raster/R/neighborhood.R
pkg/raster/R/overlay.R
pkg/raster/R/polygonToRaster.R
pkg/raster/R/raster.create.R
pkg/raster/R/reclass.R
pkg/raster/R/round.R
pkg/raster/R/setDatatype.R
pkg/raster/R/values.R
pkg/raster/R/write.R
pkg/raster/R/writeGDAL.R
pkg/raster/R/writeRaster.R
pkg/raster/man/LinesToRaster.Rd
pkg/raster/man/PolygonsToRaster.Rd
pkg/raster/man/aggregate-methods.Rd
pkg/raster/man/calc.Rd
pkg/raster/man/export.Rd
pkg/raster/man/set.Rd
pkg/raster/man/setDatatype.Rd
pkg/raster/man/write.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/DESCRIPTION 2009-02-11 09:33:47 UTC (rev 272)
@@ -1,7 +1,7 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.8-3
+Version: 0.8.8-4
Date: 11-Feb-2009
Depends: methods, sp, rgdal (>= 0.5-33), R (>= 2.8.0)
Author: Robert J. Hijmans & Jacob van Etten
Modified: pkg/raster/R/Merge.R
===================================================================
--- pkg/raster/R/Merge.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/Merge.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -36,11 +36,11 @@
isint <- TRUE
for (i in 1:length(rasters)) {
- if (rasters[[i]]@file at datatype != 'integer') {
+ if (rasters[[i]]@file at datatype != 'INT4S') {
isInt <- FALSE
}
}
- if (isInt) { outraster <- setDatatype(outraster, 'integer') }
+ if (isInt) { outraster <- setDatatype(outraster, 'INT4S') }
rowcol <- matrix(0, ncol=3, nrow=length(rasters))
for (i in 1:length(rasters)) {
Modified: pkg/raster/R/aggregate.R
===================================================================
--- pkg/raster/R/aggregate.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/aggregate.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -2,13 +2,13 @@
# International Rice Research Institute
#contact: r.hijmans at gmail.com
# Date : October 2008
-# Version 0,7
+# Version 0.8
# Licence GPL v3
setMethod('aggregate', signature(x='RasterLayer'),
-function(x, fact=2, fun=mean, expand=TRUE, rm.NA=TRUE, filename="", overwrite=FALSE, asInt = FALSE) {
+function(x, fact=2, fun=mean, expand=TRUE, rm.NA=TRUE, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S') {
if (length(fact)==1) {
fact <- round(fact)
if (fact < 2) { stop('fact should be > 1') }
@@ -34,21 +34,25 @@
xmx <- xmin(x) + csteps * xfact * xres(x)
outRaster <- setRaster(x, filename)
+ outRaster <- setDatatype(outRaster, datatype)
bndbox <- newBbox(xmin(x), xmx, ymn, ymax(x))
outRaster <- setBbox(outRaster, bndbox, keepres=F)
outRaster <- setRowCol(outRaster, nrows=rsteps, ncols=csteps)
- if (asInt) { outRaster <- setDatatype(outRaster, 'integer') }
-
if (dataContent(x) == 'all') {
cols <- rep(rep(1:csteps, each=xfact)[1:ncol(x)], times=nrow(x))
rows <- rep(1:rsteps, each=ncol(x) * yfact)[1:ncell(x)]
cells <- cellFromRowCol(x, rows, cols)
- if (rm.NA) { outRaster <- setValues(outRaster, as.vector(tapply(values(x), cells, function(x){fun(na.omit(x))})))
- } else {outRaster <- setValues(outRaster, as.vector(tapply(values(x), cells, fun))) }
+ if (rm.NA) {
+ outRaster <- setValues(outRaster, as.vector(tapply(values(x), cells, function(x){fun(na.omit(x))})))
+ } else {
+ outRaster <- setValues(outRaster, as.vector(tapply(values(x), cells, fun)))
+ }
- if (filename(outRaster) != "") {writeRaster(outRaster, overwrite=overwrite)}
+ if (filename(outRaster) != "") {
+ outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype)
+ }
} else if ( dataSource(x) == 'disk') {
@@ -78,7 +82,7 @@
v <- c(v, vals)
} else {
outRaster <- setValues(outRaster, vals, r)
- outRaster <- writeRaster(outRaster, overwrite=overwrite)
+ outRaster <- writeRaster(outRaster, overwrite=overwrite, filetype=filetype)
}
}
if (filename(outRaster) == "") {
@@ -88,3 +92,4 @@
return(outRaster)
}
)
+
Modified: pkg/raster/R/calc.R
===================================================================
--- pkg/raster/R/calc.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/calc.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -1,29 +1,32 @@
# Author: Robert J. Hijmans, r.hijmans at gmail.com
# International Rice Research Institute
# Date : June 2008
-# Version 0,8
+# Version 0.8
# Licence GPL v3
-calc <- function(raster, fun=sqrt, filename="", overwrite=FALSE, asInt=FALSE) {
+calc <- function(raster, fun=sqrt, filename="", overwrite=FALSE, filetype='raster', datatype='FLT4S') {
if (length(fun(5)) > 1) {
stop("function 'fun' returns more than one value")
}
filename <- trim(filename)
outraster <- setRaster(raster, filename)
- if (asInt) {setDatatype(outraster, 'integer')}
+ outraster <- setDatatype(outraster, datatype)
+
if (!(dataContent(raster) == 'all' | dataContent(raster) == 'sparse' | dataSource(raster) == 'disk')) {
stop('raster has no data on disk, nor a complete set of raster values in memory')
}
if ( dataContent(raster) == 'all') {
outraster <- setValues(outraster, fun(values(raster)))
- if (filename(outraster)!="") { outraster <- writeRaster(outraster, overwrite=overwrite)
+ if (filename(outraster)!="") {
+ outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
}
} else if ( dataContent(raster) == 'sparse') {
outraster <- setValuesSparse(outraster, fun(values(raster)), dataIndices(raster))
- if (filename(outraster) != "") { outraster <- writeRaster(outraster, overwrite=overwrite)
+ if (filename(outraster) != "") {
+ outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
}
} else if (dataSource(raster) == 'disk') {
v <- vector(length=0)
@@ -33,7 +36,7 @@
v <- c(v, fun(values(raster)))
} else {
outraster <- setValues(outraster, fun(values(raster)), r)
- outraster <- writeRaster(outraster, overwrite=overwrite)
+ outraster <- writeRaster(outraster, overwrite=overwrite, filetype=filetype)
}
}
if (filename(outraster) == "") { outraster <- setValues(outraster, v) }
@@ -42,27 +45,3 @@
}
-
-mCalc <- function(object, fun=sum, filename="", overwrite=FALSE, asInt=FALSE) {
- if (length(fun(seq(1:5))) > 1) {
- stop("function 'fun' returns more than one value")
- }
-
- outraster <- setRaster(object at layers[[1]], filename)
- if (filename(outraster)=="") {
- object <- readAll(object)
- outraster <- setValues(outraster, apply(values(object), 1, fun))
- } else {
- if (asInt) {
- outraster <- setDatatype(outraster, "integer")
- }
- for (r in 1:nrow(object)) {
- object <- readRow(object, r)
- vals <- apply(values(object), 1, fun)
- outraster <- setValues(outraster, vals, r)
- outraster <- writeRaster(outraster, overwrite=overwrite)
- }
- }
- return(outraster)
-}
-
Added: pkg/raster/R/clearValues.R
===================================================================
--- pkg/raster/R/clearValues.R (rev 0)
+++ pkg/raster/R/clearValues.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -0,0 +1,30 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+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') {
+# need to check if each raster has data on disk. Other wise should not be able to clear
+ object at data@values <- matrix(NA,0,0)
+ } else {
+ object at data@values <- vector()
+ if (dataSource(object) == 'ram') {
+ object at data@min <- Inf
+ object at data@max <- -Inf
+ object at data@haveminmax <- FALSE
+ }
+ }
+ return(object)
+}
+
+
+
Modified: pkg/raster/R/compare.logical.functions.R
===================================================================
--- pkg/raster/R/compare.logical.functions.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/compare.logical.functions.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -48,11 +48,11 @@
}
if (.CanProcessInMemory(e1, 2)) {
raster <- setRaster(e1)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, datatype='LOGICAL')
raster <- setValues(raster, values=callGeneric(.getRasterValues(e1), rep(e2, ncell(e1)) ) )
} else {
raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
rowrep <- rep(e2, ncol(e1))
for (r in 1:nrow(e1)) {
raster <- setValues(raster, callGeneric( .getRowValues(e1, r), rowrep ), r)
@@ -71,7 +71,7 @@
return(setValues(x, !values(x)))
} else {
raster <- setRaster(x, filename=tempfile())
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
for (r in 1:nrow(x)) {
raster <- setValues(raster, !.getRowValues(x, r), r)
raster <- writeRaster(raster)
@@ -89,11 +89,11 @@
}
if (.CanProcessInMemory(e2, 2)) {
raster <- setRaster(e2)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
raster <- setValues(raster, callGeneric(.getRasterValues(e2), rep(e1, ncell(e2)) ) )
} else {
raster <- setRaster(e2, filename=tempfile())
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
rowrep <- rep(e1, ncol(e2))
for (r in 1:nrow(e2)) {
raster <- setValues(raster, callGeneric( .getRowValues(e2, r), rowrep ), r)
@@ -112,11 +112,11 @@
}
if (.CanProcessInMemory(e1, 2)) {
raster <- setRaster(e1)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
raster <- setValues(raster, callGeneric(.getRasterValues(e1), .getRasterValues(e2) ) )
} else {
raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
for (r in 1:nrow(e1)) {
raster <- setValues(raster, callGeneric( .getRowValues(e1, r), .getRowValues(e2, r) ), r)
raster <- writeRaster(raster)
@@ -135,11 +135,11 @@
if ( compare(c(e1, e2)) ) {
if (.CanProcessInMemory(e1, 2)) {
raster <- setRaster(e1)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
raster <- setValues(raster, callGeneric(.getLogicalValues(e1), .getLogicalValues(e2)))
} else {
raster <- setRaster(e1, filename=tempfile())
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
for (r in 1:nrow(e1)) {
raster <- setValues(raster, callGeneric( .getLogicalRowValues(e1, r), .getLogicalRowValues(e2, r) ), r)
raster <- writeRaster(raster)
@@ -155,7 +155,7 @@
setMethod("is.na", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
return(setValues(raster, is.na(.getRasterValues(x))))
}
)
@@ -163,7 +163,7 @@
setMethod("is.nan", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
return(setValues(raster, is.nan(.getRasterValues(x))))
}
)
@@ -171,7 +171,7 @@
setMethod("is.infinite", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
return(setValues(raster, values=is.infinite(.getRasterValues(x))))
}
)
@@ -179,7 +179,7 @@
setMethod("is.finite", signature(x='RasterLayer'),
function(x) {
raster <- setRaster(x)
- raster <- setDatatype(raster, datatype='logical', datasize=2)
+ raster <- setDatatype(raster, 'LOGICAL')
return(setValues(raster, values=is.finite(.getRasterValues(x))))
}
)
Modified: pkg/raster/R/depracated.R
===================================================================
--- pkg/raster/R/depracated.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/depracated.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -3,7 +3,8 @@
...isNA <- function(raster, value=0, filename="", overwrite=FALSE, asInt=FALSE) {
fun <- function(x) { x[is.na(x)] <- value; return(x)}
- raster <- calc(raster, fun, filename, overwrite=overwrite, asInt=asInt)
+ if (asInt) { datatype <- 'INT4S' } else { datatype <- 'FLT4S' }
+ raster <- calc(raster, fun, filename, overwrite=overwrite, datatype )
return(raster)
}
@@ -16,6 +17,7 @@
} else if (operator == "==") { fun <- function(x) { x[x==value] <- NA; return(x)}
} else if (operator == "!=") { fun <- function(x) { x[x!=value] <- NA; return(x)}
}
- return(calc(raster, fun, filename, overwrite=overwrite, asInt=asInt))
+ if (asInt) { datatype <- 'INT4S' } else { datatype <- 'FLT4S' }
+ return(calc(raster, fun, filename, overwrite=overwrite, datatype))
}
Modified: pkg/raster/R/linesToRaster.R
===================================================================
--- pkg/raster/R/linesToRaster.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/linesToRaster.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -87,7 +87,7 @@
}
-linesToRaster <- function(spLines, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA") {
+linesToRaster <- function(spLines, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA", datatype='FLT4S') {
filename <- trim(filename)
if (updateRaster) {
@@ -97,6 +97,9 @@
}
}
raster <- setRaster(raster, filename)
+ raster <- setDatatype(raster, datatype)
+
+
if (class(spLines) == 'SpatialPolygons') {
spLines <- as(spLines, "SpatialLines")
}
@@ -140,7 +143,6 @@
stop('selected field is charater type')
}
}
- raster <- setDatatype(raster, class(putvals[1]))
v <- vector(length=0)
rxmn <- xmin(raster) + 0.1 * xres(raster)
Added: pkg/raster/R/mCalc.R
===================================================================
--- pkg/raster/R/mCalc.R (rev 0)
+++ pkg/raster/R/mCalc.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -0,0 +1,30 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+mCalc <- function(object, fun=sum, filename="", overwrite=FALSE, asInt=FALSE) {
+ if (length(fun(seq(1:5))) > 1) {
+ stop("function 'fun' returns more than one value")
+ }
+
+ outraster <- setRaster(object at layers[[1]], filename)
+ if (filename(outraster)=="") {
+ object <- readAll(object)
+ outraster <- setValues(outraster, apply(values(object), 1, fun))
+ } else {
+ if (asInt) {
+ outraster <- setDatatype(outraster, "INT4S")
+ }
+ for (r in 1:nrow(object)) {
+ object <- readRow(object, r)
+ vals <- apply(values(object), 1, fun)
+ outraster <- setValues(outraster, vals, r)
+ outraster <- writeRaster(outraster, overwrite=overwrite)
+ }
+ }
+ return(outraster)
+}
+
Added: pkg/raster/R/makeSparse.R
===================================================================
--- pkg/raster/R/makeSparse.R (rev 0)
+++ pkg/raster/R/makeSparse.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -0,0 +1,23 @@
+
+
+# Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+makeSparse <- function(raster) {
+ if ( dataContent(raster) == 'sparse') {return(raster)
+ } else {
+ if ( dataContent(raster) == 'all') {
+ vals <- seq(1:ncell(raster))
+ vals <- cbind(vals, values(raster))
+ vals <- na.omit(vals)
+ raster <- setValuesSparse(raster, sparsevalues=vals[,2], cellnumbers=vals[,1])
+ return(raster)
+ } else {
+ # as above, but by reading data from disk, row by row
+ stop('not implemented yet for objects with no data in memory, use readAll() first' )
+ }
+ }
+}
Modified: pkg/raster/R/neighborhood.R
===================================================================
--- pkg/raster/R/neighborhood.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/neighborhood.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -49,7 +49,7 @@
filename <- trim(filename)
ngbgrid <- setRaster(raster, filename)
- if (asInt) {setDatatype(ngbgrid, 'integer') }
+ if (asInt) {setDatatype(ngbgrid, 'INT4S') }
# first create an empty matrix with nrows = ngb and ncols = raster at ncols
ngbdata1 <- array(data = NA, dim = c(ngb, ncol(raster)))
Modified: pkg/raster/R/overlay.R
===================================================================
--- pkg/raster/R/overlay.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/overlay.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -28,7 +28,7 @@
compare(c(x, rasters))
outraster <- setRaster(x, filename)
- if (asInt) { outraster <- setDatatype(outraster, 'integer') }
+ if (asInt) { outraster <- setDatatype(outraster, 'INT4S') }
inram <- TRUE
for (i in 1:length(rasters)) {
Modified: pkg/raster/R/polygonToRaster.R
===================================================================
--- pkg/raster/R/polygonToRaster.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/polygonToRaster.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -60,7 +60,7 @@
-polygonsToRaster <- function(spPolys, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA", trackRows=c(100, 500, 1:(round(nrow(raster)/1000)) * 1000)) {
+polygonsToRaster <- function(spPolys, raster, field=0, filename="", overwrite=FALSE, updateRaster=FALSE, updateValue="NA", datatype='FLT4S', trackRows=c(100, 500, 1:(round(nrow(raster)/1000)) * 1000)) {
filename <- trim(filename)
starttime <- proc.time()
@@ -71,6 +71,7 @@
}
}
raster <- setRaster(raster, filename)
+ raster <- setDatatype(raster, datatype)
# check if bbox of raster and spPolys overlap
spbb <- bbox(spPolys)
@@ -87,7 +88,6 @@
stop('selected field is charater type')
}
}
- raster <- setDatatype(raster, class(putvals[1]))
polinfo <- matrix(NA, nrow=npol * 2, ncol=6)
addpol <- matrix(NA, nrow=500, ncol=6)
@@ -225,7 +225,7 @@
}
-.polygonsToRaster2 <- function(spPolys, raster, field=0, filename="", overwrite=FALSE) {
+.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
# but it could be optimized further
@@ -234,6 +234,8 @@
# check if bbox of raster and spPolys overlap
filename <- trim(filename)
raster <- setRaster(raster, filename)
+ raster <- setDatatype(raster, datatype)
+
spbb <- bbox(spPolys)
rsbb <- bbox(raster)
@@ -249,9 +251,8 @@
stop('selected field is charater type')
}
}
- raster <- setDatatype(raster, class(putvals[1]))
-
+
v <- vector(length=0)
rowcol <- cbind(0, 1:ncol(raster))
Modified: pkg/raster/R/raster.create.R
===================================================================
--- pkg/raster/R/raster.create.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/raster.create.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -97,7 +97,7 @@
raster <- raster(ncols=nc, nrows=nr, xmn=xn, ymn=yn, xmx=xx, ymx=yx, projstring="")
raster <- setFilename(raster, filename)
- raster <- setDatatype(raster, "numeric")
+ raster <- setDatatype(raster, "FLT4S")
raster at file@driver <- 'gdal'
@@ -173,15 +173,8 @@
raster at data@haveminmax <- TRUE
raster at file@nodatavalue <- nodataval
- inidatatype <- trim(inidatatype)
- if (substr(inidatatype, 1, 3) == "INT") { datatp="integer"
- } else if (substr(inidatatype, 1, 3) == "LOG") { datatp="logical"
- } else if (substr(inidatatype, 1, 3) == "ASC") { datatp="ascii"
- } else { datatp="numeric" }
- datasz <- as.integer(substr(inidatatype, 4, 4))
- dsign <- substr(inidatatype, 5, 1)
- if (dsign == 'U') {signed <- FALSE} else {signed <- TRUE}
- raster <- setDatatype(raster, datatype=datatp, datasize=datasz, signed=signed)
+ raster <- setDatatype(raster, inidatatype)
+
if ((byteorder == "little") | (byteorder == "big")) { raster at file@byteorder <- byteorder }
raster at file@nbands <- as.integer(nbands)
raster at file@band <- as.integer(band)
Modified: pkg/raster/R/reclass.R
===================================================================
--- pkg/raster/R/reclass.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/reclass.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -19,10 +19,10 @@
outraster <- setRaster(raster, filename)
if (asInt) {
- outraster <- setDatatype(outraster, "integer")
+ outraster <- setDatatype(outraster, "INT4S")
res <- vector(mode = "integer", length = ncol(raster))
} else {
- outraster <- setDatatype(outraster, "numeric")
+ outraster <- setDatatype(outraster, "FLT4S")
res <- vector(mode = "numeric", length = ncol(raster))
}
Modified: pkg/raster/R/round.R
===================================================================
--- pkg/raster/R/round.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/round.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -12,13 +12,13 @@
if (.CanProcessInMemory(x, 1)) {
x <- setValues(x, round(values(x), digits))
if (digits == 0) {
- x <- setDatatype(x, 'integer')
+ x <- setDatatype(x, 'INT4S')
}
return(x)
} else {
raster <- setRaster(x, filename=tempfile())
if (digits == 0) {
- x <- setDatatype(x, 'integer')
+ x <- setDatatype(x, 'INT4S')
}
for (r in 1:nrow(x)) {
raster <- setValues(raster, round(.getRowValues(x, r), digits), r)
@@ -34,11 +34,11 @@
function (x) {
if (.CanProcessInMemory(x, 1)) {
x <- setValues(x, trunc(values(x)))
- x <- setDatatype(x, 'integer')
+ x <- setDatatype(x, 'INT4S')
return(x)
} else {
raster <- setRaster(x, filename=tempfile())
- raster <- setDatatype(raster, 'integer')
+ raster <- setDatatype(raster, 'INT4S')
for (r in 1:nrow(x)) {
raster <- setValues(raster, trunc(.getRowValues(x, r)), r)
raster <- writeRaster(raster)
@@ -54,11 +54,11 @@
function (x) {
if (.CanProcessInMemory(x)) {
x <- setValues(x, ceiling(values(x)))
- x <- setDatatype(x, 'integer')
+ x <- setDatatype(x, 'INT4S')
return(x)
} else {
raster <- setRaster(x, filename=tempfile())
- raster <- setDatatype(raster, 'integer')
+ raster <- setDatatype(raster, 'INT4S')
for (r in 1:nrow(x)) {
raster <- setValues(raster, ceiling(.getRowValues(x, r)), r)
raster <- writeRaster(raster)
@@ -73,11 +73,11 @@
function (x) {
if (.CanProcessInMemory(x)) {
x <- setValues(x, floor(values(x)))
- x <- setDatatype(x, 'integer')
+ x <- setDatatype(x, 'INT4S')
return(x)
} else {
raster <- setRaster(x, filename=tempfile())
- raster <- setDatatype(raster, 'integer')
+ raster <- setDatatype(raster, 'INT4S')
for (r in 1:nrow(x)) {
raster <- setValues(raster, floor(.getRowValues(x, r)), r)
raster <- writeRaster(raster)
Deleted: pkg/raster/R/set.values.R
===================================================================
--- pkg/raster/R/set.values.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/set.values.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -1,192 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0,8
-# Licence GPL v3
-
-
-
-if (!isGeneric('setValues')) {
- setGeneric('setValues', function(object, values, rownr=-1, layer=-1)
- standardGeneric('setValues'))
- }
-
-
-
-setMethod('setValues', signature(object='RasterLayer'),
-
- function(object, values, rownr=-1, layer=-1) {
-
- if (!is.vector(values)) {stop('values must be a vector')}
- if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {
- stop('values must be numeric, integer or logical.') }
-
-
- if (length(values) == 1) {
- if (rownr > 0) {
- values <- rep(values, ncol(object))
- } else {
- values <- rep(values, ncell(object))
- }
- }
-
- if (length(values) == ncell(object)) {
- if (rownr > 0) {
- stop("if setting all values, rownr must be < 1")
- }
- object at data@values <- values
- object at data@content <- 'all'
- object at data@source <- 'ram'
- object at data@indices <- c(1, ncell(object))
- object <- setMinMax(object)
- return(object)
- } else if (length(values) == ncol(object)) {
- rownr <- round(rownr)
- if (rownr < 1 | rownr > nrow(object)) {
- stop(paste("rownumber out of bounds:", rownr))
- }
- object at data@values <- values
- object at data@content <- 'row'
- firstcell <- cellFromRowCol(object, rownr=rownr, colnr=1)
- lastcell <- cellFromRowCol(object, rownr=rownr, colnr=ncol(object))
- object at data@indices <- c(firstcell, lastcell)
- return(object)
- } else {
- stop("length(values) is not equal to ncell(object) or ncol(object)")
- }
- }
-)
-
-
-
-setMethod('setValues', signature(object='RasterStack'),
- function(object, values, rownr=-1, layer=-1) {
- if (!(is.vector(values) | is.matrix(values))) {
- stop('values must be a vector or a matrix')
- }
- if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {
- stop('values must be numeric, integer or logical.')
- }
- rownr <- round(rownr)
-
- if (is.matrix(values)) {
- if (ncol(values) == nlayers(object)) {
- object at data@values <- values
- if (nrow(values) == 1) {
- object at data@content <= 'all'
- object at data@indices <- c(1, ncell(object))
- } else if (nrow(values) == nrow(object)) {
- object at data@content <= 'row'
- firstcell <- cellFromRowCol(object, rownr=rownr, colnr=1)
- lastcell <- cellFromRowCol(object, rownr=rownr, colnr=ncol(object))
- object at data@indices <- c(firstcell, lastcell)
- } else {
- stop('either set all data or a single row')
- }
- } else if (ncol(values) == 1) {
- values <- as.vector(values)
- } else {
- stop('either set values for all layers or for a single layer')
- }
- }
-
- if (is.vector(values)) {
- layer <- round(layer)
- if (layer < 1) {
- print(class(object))
- stop('specify layer') }
- if (layer > nlayers(object)) {stop('layer number too high')}
-
-
- if (length(values) == ncell(object)) {
- if (rownr > 0) {
- stop("if setting all values, rownr must be < 1")
- }
- if (dataContent(object) != 'all') {
- stop(" you can only setValues with these values if the dataContent = 'all'") }
- object at data@values[,layer] <- values
- # object <- setMinMax(object)
- } else if (length(values) == ncol(object)) {
- if (rownr < 1 | rownr > nrow(object)) {
- stop(paste("rownumber out of bounds:", rownr))
- }
- object at data@values <- values
- object at data@content <- 'row'
- firstcell <- cellFromRowCol(object, rownr=rownr, colnr=1)
- lastcell <- cellFromRowCol(object, rownr=rownr, colnr=ncol(object))
- object at data@indices <- c(firstcell, lastcell)
- }
- } else {
- stop("length(values) is not equal to ncell(object) or ncol(object)")
- }
- }
-)
-
-
-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') {
- object at data@values <- matrix(NA,0,0)
- } else {
- object at data@values <- vector()
- }
- object at data@min <- Inf
- object at data@max <- -Inf
- object at data@haveminmax <- FALSE
- return(object)
-}
-
-
-
-makeSparse <- function(raster) {
- if ( dataContent(raster) == 'sparse') {return(raster)
- } else {
- if ( dataContent(raster) == 'all') {
- vals <- seq(1:ncell(raster))
- vals <- cbind(vals, values(raster))
- vals <- na.omit(vals)
- raster <- setValuesSparse(raster, sparsevalues=vals[,2], cellnumbers=vals[,1])
- return(raster)
- } else {
- # as above, but by reading data from disk, row by row
- stop('not implemented yet for objects with no data in memory, use readAll() first' )
- }
- }
-}
-
-setValuesSparse <- function(raster, sparsevalues, cellnumbers) {
- if (!(isTRUE(length(cellnumbers) == (length(sparsevalues))))) {
- stop()
- }
- raster at data@content <- 'sparse'
- raster at data@values <- sparsevalues
- raster at data@indices <- cellnumbers
- raster at data@source <- 'ram'
- raster <- setMinMax(raster)
- return(raster)
-}
-
-setValuesBlock <- function(raster, blockvalues, firstcell, lastcell) {
- if (!is.vector(blockvalues)) { stop('values must be a vector') }
- if (length(blockvalues) == 0) { stop('length(blockvalues==0). If this is intended use raster.data.clear(raster)') }
- if (!(is.numeric(blockvalues) | is.integer(blockvalues) | is.logical(blockvalues))) { stop('values must be numeric, integer or logical') }
-
- firstcol <- colFromCell(raster, firstcell)
- lastcol <- colFromCell(raster, lastcell)
- firstrow <- rowFromCell(raster, firstcell)
- lastrow <- rowFromCell(raster, lastcell)
- ncells <- (lastcol - firstcol + 1) * (lastrow - firstrow + 1)
-
- if (ncells != length(blockvalues)) {
- stop( paste("length(blockdata):", length(blockvalues), "does not match the number implied by firstcell and lastcell:", ncells))
- }
- raster at data@values <- blockvalues
- raster at data@content <- 'block'
- raster at data@indices <- c(firstcell, lastcell)
- return(raster)
-}
-
Modified: pkg/raster/R/setDatatype.R
===================================================================
--- pkg/raster/R/setDatatype.R 2009-02-11 03:33:30 UTC (rev 271)
+++ pkg/raster/R/setDatatype.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -4,78 +4,74 @@
# Version 0.8
# Licence GPL v3
-setDatatype <- function(raster, datatype, datasize=4, signed=TRUE) {
- if (datatype == "numeric") {
+setDatatype <- function(raster, datatype) {
+ datatype <- trim(datatype)
+ if (!(datatype %in% c('LOGICAL', 'INT1S', 'INT2S', 'INT4S', 'INT8S', 'INT1U', 'INT2U', 'INT4U', 'INT8U', 'FLT4S', 'FLT8S'))) {
+ stop('not a valid data type')
+ }
+ type <- substr(datatype,1,3)
+ size <- substr(datatype,4,4)
+ signed <- substr(datatype,1,3) != 'U'
+
+ raster at file@datanotation <- datatype
+
+ if (type == "FLT") {
+ raster at file@datatype <- 'numeric'
raster at file@datasigned <- TRUE
- raster at file@datatype <- datatype
if (dataContent(raster) != 'nodata') {
raster at data@values <- as.numeric(values(raster))
}
- if (datasize == 4) {
+ if (size == '4') {
raster at file@datasize <- as.integer(4)
raster at file@nodatavalue <- -3.4E38
- raster at file@datanotation <- "FLT4S"
- } else if (datasize == 8) {
+ } else if (size == '8') {
raster at file@datasize <- as.integer(8)
raster at file@nodatavalue <- -1.7E308
- raster at file@datanotation <- "FLT8S"
} else {
- stop("invalid datasize for this datatype")
+ stop("invalid datasize for a FLT (should be 4 or 8)")
}
- } else if (datatype == "integer") {
+ } else if (type == "INT") {
+ raster at file@datatype <- 'integer'
raster at file@datasigned <- signed
- raster at file@datatype <- datatype
raster at data@min <- round(minValue(raster))
raster at data@max <- round(maxValue(raster))
if (dataContent(raster) != 'nodata') {
raster at data@values <- as.integer(round(values(raster)))
}
- if (datasize == 4) {
+ if (size == '4') {
raster at file@datasize <- as.integer(4)
if (signed) {
- raster at file@datanotation <- "INT4S"
raster at file@nodatavalue <- -2147483647
} else {
- raster at file@datanotation <- "INT4U"
raster at file@nodatavalue <- 4294967295
}
- } else if (datasize == 2) {
+ } else if (size == '2') {
raster at file@datasize <- as.integer(2)
if (signed) {
- raster at file@datanotation <- "INT2S"
raster at file@nodatavalue <- -32768
} else {
- raster at file@datanotation <- "INT2U"
raster at file@nodatavalue <- 65535
}
- } else if (datasize == 1) {
+ } else if (size == '1') {
raster at file@datasize <- as.integer(1)
# there is no nodata value for byte
raster at file@nodatavalue <- -9999
- if (signed) {
- raster at file@datanotation <- "INT1S"
- } else {
- raster at file@datanotation <- "INT1U"
- }
warning("binary files of a single byte do not have NA values on disk")
- } else if (datasize == 8) {
+ } else if (size == '8') {
raster at file@datasize <- as.integer(8)
if (signed) {
- raster at file@datanotation <- "INT8S"
raster at file@nodatavalue <- -9223372036854775808
} else {
- raster at file@datanotation <- "INT8U"
raster at file@nodatavalue <- 18446744073709551615
}
} else {
stop("invalid datasize for this datatype")
}
- } else if ( datatype == 'logical' ) {
- raster at file@datasigned <- TRUE
- raster at file@datatype <- datatype
+ } else if ( type == 'LOG' ) {
+ raster at file@datatype <- 'logical'
+ raster at file@datasigned <- TRUE
raster at file@datasize <- as.integer(1)
raster at file@nodatavalue <- -127
- raster at file@datanotation <- "LOGICAL"
} else {
stop("unknown datatype")
}
Added: pkg/raster/R/setValues.R
===================================================================
--- pkg/raster/R/setValues.R (rev 0)
+++ pkg/raster/R/setValues.R 2009-02-11 09:33:47 UTC (rev 272)
@@ -0,0 +1,161 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+if (!isGeneric('setValues')) {
+ setGeneric('setValues', function(object, values, rownr=-1, layer=-1)
+ standardGeneric('setValues'))
+ }
+
+
+
+setMethod('setValues', signature(object='RasterLayer'),
+
+ function(object, values, rownr=-1, layer=-1) {
+
+ if (!is.vector(values)) {stop('values must be a vector')}
+ if (!(is.numeric(values) | is.integer(values) | is.logical(values))) {
+ stop('values must be numeric, integer or logical.') }
+
+
+ if (length(values) == 1) {
+ if (rownr > 0) {
+ values <- rep(values, ncol(object))
+ } else {
+ values <- rep(values, ncell(object))
+ }
+ }
+
+ if (length(values) == ncell(object)) {
+ if (rownr > 0) {
+ stop("if setting all values, rownr must be < 1")
+ }
+ object at data@values <- values
+ object at data@content <- 'all'
+ object at data@source <- 'ram'
+ object at data@indices <- c(1, ncell(object))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 272
More information about the Raster-commits
mailing list