[Raster-commits] r163 - in pkg/raster: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jan 20 03:55:25 CET 2009
Author: rhijmans
Date: 2009-01-20 03:55:24 +0100 (Tue, 20 Jan 2009)
New Revision: 163
Added:
pkg/raster/R/writeAscii.R
pkg/raster/R/writeGDAL.R
pkg/raster/R/writeRaster.R
pkg/raster/man/write.Rd
Removed:
pkg/raster/R/exportGDAL.R
pkg/raster/R/raster.write.R
pkg/raster/man/raster.write.Rd
Modified:
pkg/raster/DESCRIPTION
pkg/raster/R/export.R
pkg/raster/R/replacement.R
pkg/raster/R/set.R
pkg/raster/man/export.Rd
pkg/raster/man/properties.Rd
Log:
Modified: pkg/raster/DESCRIPTION
===================================================================
--- pkg/raster/DESCRIPTION 2009-01-19 17:51:40 UTC (rev 162)
+++ pkg/raster/DESCRIPTION 2009-01-20 02:55:24 UTC (rev 163)
@@ -1,8 +1,8 @@
Package: raster
Type: Package
Title: Raster data handling for geographic data analysis and modeling
-Version: 0.8.6
-Date: 19-Jan-2009
+Version: 0.8.6-2
+Date: 20-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/export.R
===================================================================
--- pkg/raster/R/export.R 2009-01-19 17:51:40 UTC (rev 162)
+++ pkg/raster/R/export.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -29,9 +29,10 @@
}
if (filetype == "ascii") {
filename <- setFileExtension(filename, ".asc")
+ outras <- setRaster(raster, filename)
for (r in 1:nrow(raster)) {
- raster <- readRow(raster, r)
- writeAscii(raster, filename, overwrite=overwrite)
+ outras <- setValues(outras, values(readRow(raster, r)), r)
+ .writeAscii(outras, overwrite=overwrite)
}
} else if (filetype == "bil") {
@@ -81,51 +82,7 @@
-writeAscii <- function(raster, filename, overwrite=FALSE) {
- if (dataIndices(raster)[1] == 1) {
- resdif <- abs((yres(raster) - xres(raster)) / yres(raster) )
- if (resdif > 0.01) {
- stop(paste("raster has unequal horizontal and vertical resolutions","\n", "these data cannot be stored in arc-ascii format"))
- }
- if (!overwrite & file.exists(filename)) {
- stop(paste(filename, "exists. Use 'overwrite=TRUE'"))
- }
-
- thefile <- file(filename, "w") # open an txt file connection
- cat("NCOLS", ncol(raster), "\n", file = thefile)
- cat("NROWS", nrow(raster), "\n", file = thefile)
- cat("XLLCORNER", xmin(raster), "\n", file = thefile)
- cat("YLLCORNER", ymin(raster), "\n", file = thefile)
- cat("CELLSIZE", xres(raster), "\n", file = thefile)
- cat("NODATA_value", .nodatavalue(raster), "\n", file = thefile)
- close(thefile) #close connection
-
- } else if ( dataIndices(raster)[2] > ncell(raster)) {
- stop(paste('writing beyond end of file. last cell:', dataIndices(raster)[2], '>', ncell(raster)))
- }
-
-
- raster at data@values[is.na(values(raster))] <- .nodatavalue(raster)
- if (dataContent(raster) == 'all') {
- for (r in 1:nrow(raster)) {
- write.table(t(valuesRow(raster, r)), filename, append = TRUE, quote = FALSE,
- sep = " ", eol = "\n", dec = ".", row.names = FALSE, col.names = FALSE)
- }
- } else {
- write.table(t(values(raster)), filename, append = TRUE, quote = FALSE,
- sep = " ", eol = "\n", dec = ".", row.names = FALSE, col.names = FALSE)
- }
-
- if ( dataIndices(raster)[2] == ncell(raster)) {
- return(rasterFromFile(filename))
- } else {
- return("writing in progress")
- }
-}
-
-
-
writeHeader <- function(raster, type) {
type <- toupper(type)
if (type=="BIL") {
Deleted: pkg/raster/R/exportGDAL.R
===================================================================
--- pkg/raster/R/exportGDAL.R 2009-01-19 17:51:40 UTC (rev 162)
+++ pkg/raster/R/exportGDAL.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -1,138 +0,0 @@
-# R function for the raster package
-# Author: Robert J. Hijmans
-# International Rice Research Institute. Philippines
-# contact: r.hijmans at gmail.com
-# Date : January 2009
-# Version 0.8
-# Licence GPL v3
-
-
-# based on create2GDAL and saveDataset from the rgdal package
-# authors: Timothy H. Keitt, Roger Bivand, Edzer Pebesma, Barry Rowlingson
-
-.isSupportedGDALdriver <- function(dname) {
- gdrivers <- c("ADRG", "BMP", "BT", "EHdr", "ELAS", "ENVI", "ERS", "GSBG", "GTiff", "HFA", "IDA", "ILWIS", "INGR", "Leveller", "MEM", "MFF", "MFF2", "NITF", "PAux", "PCIDSK", "PNM", "RMF", "RST", "SGI", "Terragen", "VRT")
- res <- dname %in% gdrivers
- if (!res) { stop(paste(dname,"is not a supported GDAL file format. Choose from: \n ADRG, BMP, BT, EHdr, ELAS, ENVI, ERS, GSBG, GTiff, HFA, IDA, ILWIS,\n INGR, Leveller, MEM, MFF, MFF2, NITF, PAux, PCIDSK, PNM, RMF, RST, SGI, Terragen, VRT" ) ) }
- return(res)
-}
-
-
-.getGDALtransient <- function(raster, filename, gdalfiletype, mvFlag, options, overwrite, ForceIntOutput) {
- .isSupportedGDALdriver(gdalfiletype)
-
-# this is a RasterLayer hence nbands = 1:
- nbands = nlayers(raster)
-# but we keep this for later (stack, brick)
-
- if (file.exists(filename)) {
- if (!overwrite) {
- stop("filename exists; use overwrite=TRUE")
- } else if (!file.remove(filename)) {
- stop("cannot delete file. permissin denied.")
- }
- }
-
-#.GDALDataTypes <- c('Unknown', 'Byte', 'UInt16', 'Int16', 'UInt32','Int32', 'Float32', 'Float64', 'CInt16', 'CInt32', 'CFloat32', 'CFloat64')
-# this needs to get fancier; depending on object and the abilties of the drivers
- if (dataType(raster) == 'integer' | ForceIntOutput) {
- dataformat <- 'Int32'
- if (raster at data@haveminmax) {
- if (minValue(raster) > -32768 & maxValue(raster) <= 32767) {
- dataformat <- 'Int16'
- }
- }
- } else { dataformat <- 'Float32' }
-
- driver = new("GDALDriver", gdalfiletype)
-
- if (!is.null(options) && !is.character(options)) { stop("options not character") }
- transient = new("GDALTransientDataset", driver = driver, rows = nrow(raster), cols = ncol(raster), bands = nbands, type = dataformat, options = options, handle = NULL)
-
- gt <- c(xmin(raster), xres(raster), 0, ymax(raster), 0, -yres(raster))
- .Call("RGDAL_SetGeoTransform", transient, gt, PACKAGE = "rgdal")
- p4s <- projection(raster)
- .Call("RGDAL_SetProject", transient, p4s, PACKAGE = "rgdal")
-
- return(transient)
-}
-
-
-
-exportGDAL <- function(raster, filename, gdalfiletype = "GTiff", overwrite=FALSE, ForceIntOutput = FALSE ) {
- mvFlag = NA
- options = NULL
- nbands = nlayers(raster)
-
- transient <- .getGDALtransient(raster, filename, gdalfiletype, mvFlag, options, overwrite, ForceIntOutput)
-
- for (band in 1:nbands) {
-
- if (dataContent(raster)=='all') {
-# if (!is.na(mvFlag)) vals[is.na(vals)] = mvFlag
-# This would work, but could potentially lead to memory problems (making a copy of the values before writing)
-# x <- putRasterData(transient, t(values(raster, format='matrix')), band, c(0, 0))
- for (r in 1:nrow(raster)) {
- x <- putRasterData(transient, valuesRow(raster, r), band, c((r-1), 0))
- }
- } else {
- if (dataSource(raster)=='ram') {
- stop("No data on disk, and not all values in memory. Cannot write the file")
- }
- for (r in 1:nrow(raster)) {
- x <- putRasterData(transient, values(readRow(raster, r)), band, c((r-1), 0))
- }
- }
-
-# if (!is.na(mvFlag)) {
-# transient_b <- getRasterBand(dataset = transient, band = band)
-# .Call("RGDAL_SetNoDataValue", transient_b, as.double(mvFlag), PACKAGE = "rgdal")
-# }
- }
- saveDataset(transient, filename)
- GDAL.close(transient)
-
-# do NOT do this, it removes the driver for future use!!! ????
-# GDAL.close(driverobj)
-
- outras <- rasterFromFile(filename)
- outras at data@min <- raster at data@min
- outras at data@max <- raster at data@max
- if (!is.na((outras at data@min))) { outras at data@haveminmax <- TRUE }
-
- return(outras)
-}
-
-
-writeGDALrow <- function(raster, filename, gdalfiletype = "GTiff", rownr, overwrite=FALSE, ForceIntOutput = FALSE ) {
- if (rownr == 1) {
- mvFlag = NA
- options = NULL
- transient <- .getGDALtransient(raster, filename, gdalfiletype, mvFlag, options, overwrite, ForceIntOutput)
- attr(raster, "transient") <- transient
- }
-
- for (band in 1:nlayers(raster)) {
- x <- putRasterData(raster at transient, values(raster, rownr), band, c((rownr-1), 0))
- }
-
-# if (!is.na(mvFlag)) {
-# transient_b <- getRasterBand(dataset = transient, band = band)
-# .Call("RGDAL_SetNoDataValue", transient_b, as.double(mvFlag), PACKAGE = "rgdal")
-# }
-
- if (rownr == nrow(raster)) {
- saveDataset(raster at transient, filename)
- GDAL.close(raster at transient)
-# do NOT do this, it removes the driver for future use!!! ????
-# GDAL.close(driverobj)
- outras <- rasterFromFile(filename)
- outras at data@min <- raster at data@min
- outras at data@max <- raster at data@max
- if (!is.na((outras at data@min))) { outras at data@haveminmax <- TRUE }
- return(outras)
- } else {
- return(raster)
- }
-}
-
Deleted: pkg/raster/R/raster.write.R
===================================================================
--- pkg/raster/R/raster.write.R 2009-01-19 17:51:40 UTC (rev 162)
+++ pkg/raster/R/raster.write.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -1,211 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0,1
-# Licence GPL v3
-
-
-
-.setFileExtensionValues <- function(fname) {
- fname <- setFileExtension(fname, ".gri")
- return(fname)
-}
-
-.setFileExtensionHeader <- function(fname) {
- fname <- setFileExtension(fname, ".grd")
- return(fname)
-}
-
-
-writeRaster <- function(raster, overwrite=FALSE) {
- if (dataContent(raster) == 'row' ) {
- raster <- .writeRasterRow(raster, overwrite)
- } else if (dataContent(raster) != 'all' & dataContent(raster) != 'sparse' ) {
- stop('First use setValues()')
- } else {
- raster <- .writeRasterAll(raster, overwrite)
- }
- return(raster)
-}
-
-
-
-.writeRasterAll <- function(raster, overwrite=FALSE) {
- raster <- setFilename(raster, .setFileExtensionHeader(filename(raster)))
- if (filename(raster) == "") {
- stop('first provide a filename. E.g.: raster <- setFilename(raster, "c:/myfile")')
- }
- if (!overwrite & file.exists(filename(raster))) {
- stop(paste(filename(raster),"exists.","use 'overwrite=TRUE' if you want to overwrite it"))
- }
- raster at file@driver <- 'raster'
- raster at file@gdalhandle <- list()
- raster at data@values[is.nan(raster at data@values)] <- NA
- raster at data@values[is.infinite(raster at data@values)] <- NA
- raster <- setMinMax(raster)
-
- if ( raster at file@datatype =='integer') {
- if (xmin(raster) > -32767 & xmax(raster) < 32768) {
- raster <- setDatatype(raster, 'integer', datasize=2)
- raster at data@values <- as.integer(round(values(raster)))
- } else if (xmin(raster) > -2147483647 & xmax(raster) < 2147483648 ) {
- raster <- setDatatype(raster, 'integer', datasize=4)
- raster at data@values <- as.integer(round(values(raster)))
- } else if (xmin(raster) > -(2^63/2) & xmax(raster) < (2^64/2)) {
- raster <- setDatatype(raster, 'integer', datasize=8)
- raster at data@values <- as.integer(round(values(raster)))
- } else {
- raster <- setDatatype(raster, 'numeric', datasize=8)
- raster at data@values <- as.numeric(values(raster))
- }
- } else {
- if (xmin(raster) < -3.4E38 | xmax(raster) > 3.4E38) {
- raster <- setDatatype(raster, 'numeric', 8)
- } else {
- raster <- setDatatype(raster, 'numeric', 4)
- }
- }
-
- if (raster at data@content == 'sparse') {
- raster <- .writeSparse(raster, overwrite)
- } else {
- binraster <- .setFileExtensionValues(filename(raster))
- con <- file(binraster, "wb")
- writeBin( values(raster), con, size = raster at file@datasize)
- close(con)
- .writeRasterHdr(raster)
- }
- return(raster)
-}
-
-
-
-.writeRasterRow <- function(raster, overwrite=FALSE) {
- if (dataContent(raster) != 'row') { stop('raster does not contain a row') }
-
- if (dataIndices(raster)[1] == 1) {
- # FIRST ROW
- raster <- setFilename(raster, .setFileExtensionHeader(filename(raster)))
- if (filename(raster) == "") {
- stop('first provide a filename. E.g.: raster <- setFilename(raster, "c:/myfile")')
- }
- if (!overwrite & file.exists(filename(raster))) {
- stop(paste(filename(raster),"exists.","use 'overwrite=TRUE' if you want to overwrite it"))
- }
- raster at file@name <- .setFileExtensionHeader(filename(raster))
- binraster <- .setFileExtensionValues(filename(raster))
- attr(raster, "filecon") <- file(binraster, "wb")
- raster at data@min <- 3e34
- raster at data@max <- -3e34
- raster at data@haveminmax <- FALSE
- raster at file@driver <- 'raster'
- raster at file@gdalhandle <- list()
- }
-
- if (raster at file@datatype == "integer") { raster at data@values <- as.integer(round(raster at data@values)) }
- if (class(values(raster)) == "integer" & raster at file@datatype == "numeric") { raster at data@values <- as.numeric(values(raster)) }
-
- raster at data@values[is.nan(raster at data@values)] <- NA
- raster at data@values[is.infinite(raster at data@values)] <- NA
- rsd <- na.omit(raster at data@values) # min and max values
- if (length(rsd) > 0) {
- raster at data@min <- min(raster at data@min, min(rsd))
- raster at data@max <- max(raster at data@max, max(rsd))
- }
-
-# raster at data@values[is.na(raster at data@values)] <- raster at file@nodatavalue
- writeBin(as.vector(raster at data@values), raster at filecon, size = raster at file@datasize)
-
- if (dataIndices(raster)[2] == ncell(raster)) {
- # LAST ROW
- .writeRasterHdr(raster)
- close(raster at filecon)
- raster at data@haveminmax <- TRUE
- raster at data@source <- 'disk'
- raster at data@content <- 'nodata'
- raster at data@values <- vector(length=0)
- }
- if (dataIndices(raster)[2] > ncell(raster)) {
- stop(paste('writing beyond end of file. last cell:', dataIndices(raster)[2], '>', ncell(raster)))
- }
- return(raster)
-}
-
-
-.writeSparse <- function(raster, overwrite=FALSE) {
-
- raster at file@driver <- 'raster'
- raster at file@gdalhandle <- list()
- raster <- setFilename(raster, .setFileExtensionHeader(filename(raster)))
- if (!overwrite & file.exists(filename(raster))) {
- stop(paste(filename(raster), "exists. Use 'overwrite=TRUE' if you want to overwrite it"))
- }
-
- raster at data@values[is.nan(values(raster))] <- NA
- if (raster at file@datatype == "integer") {
- raster at data@values <- as.integer(values(raster))
- }
- if (class(values(raster))=='integer') {
- raster <- setDatatype(raster, 'integer')
- }
- raster <- setMinMax(raster)
-
- binraster <- .setFileExtensionValues(filename(raster))
- con <- file(binraster, "wb")
- writeBin( as.vector(dataIndices(raster)), con, size = as.integer(4))
- writeBin( as.vector(values(raster)), con, size = raster at file@datasize)
- close(con)
-
- # add the 'sparse' key word to the hdr file!!!
- .writeRasterHdr(raster)
- return(raster)
-}
-
-
-.writeRasterHdr <- function(raster) {
- rastergrd <- .setFileExtensionHeader(filename(raster))
- thefile <- file(rastergrd, "w") # open an txt file connectionis
- cat("[general]", "\n", file = thefile)
- cat("creator=R package:raster", "\n", file = thefile)
- cat("created=", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n", file = thefile)
- cat("title=", raster at file@shortname, "\n", file = thefile)
- cat("[georeference]", "\n", file = thefile)
- cat("nrows=", nrow(raster), "\n", file = thefile)
- cat("ncols=", ncol(raster), "\n", file = thefile)
- cat("xmin=", xmin(raster), "\n", file = thefile)
- cat("ymin=", ymin(raster), "\n", file = thefile)
- cat("xmax=", xmax(raster), "\n", file = thefile)
- cat("ymax=", ymax(raster), "\n", file = thefile)
- cat("xres=", xres(raster), "\n", file = thefile)
- cat("yres=", yres(raster), "\n", file = thefile)
- cat("projection=", projection(raster), "\n", file = thefile)
- cat("[data]", "\n", file = thefile)
- if (raster at file@datatype == 'ascii') {
- datatype <- "ASC"
- } else if (raster at file@datatype == 'integer') {
- datatype <- "INT"
- } else {
- datatype <- "FLT"
- }
- if (datatype != "ASC") {
- datatype <- paste(datatype, raster at file@datasize, "BYTES", sep="")
- cat("DataType=", datatype, "\n", file = thefile)
- cat("ByteOrder=", .Platform$endian, "\n", file = thefile)
- }
- cat("nbands=", nbands(raster), "\n", file = thefile)
- cat("bandOrder=", raster at file@bandorder, "\n", file = thefile)
- cat("minValue=", minValue(raster), "\n", file = thefile)
- cat("maxValue=", maxValue(raster), "\n", file = thefile)
- cat("NoDataValue=", .nodatavalue(raster), "\n", file = thefile)
-# cat("Sparse=", raster at sparse, "\n", file = thefile)
-# cat("nCellvals=", raster at data@ncellvals, "\n", file = thefile)
- close(thefile)
-}
-
-
-#
-#write.gdal <- function(gdata, filename, filetype = "GTiff", gdata) {
-# datatype <- "Float32"
-# writeGDAL(gdata, filename, drivername = filetype, type = datatype, mvFlag = NA, options=NULL)
-#}
-
Modified: pkg/raster/R/replacement.R
===================================================================
--- pkg/raster/R/replacement.R 2009-01-19 17:51:40 UTC (rev 162)
+++ pkg/raster/R/replacement.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -4,7 +4,11 @@
# Version 0,8
# Licence GPL v3
+'filename<-' <- function(x, value) {
+ return( setFilename(x, value) )
+}
+
'projection<-' <- function(x, value) {
return( setProjection(x, value) )
}
Modified: pkg/raster/R/set.R
===================================================================
--- pkg/raster/R/set.R 2009-01-19 17:51:40 UTC (rev 162)
+++ pkg/raster/R/set.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -48,7 +48,7 @@
shortname <- fileName(filename)
shortname <- setFileExtension(shortname, "")
shortname <- gsub(" ", "_", shortname)
- if (object at file@nbands > 1) { shortname <- paste(shortname, "_", object at file@band) }
+ if (nbands(object) > 1) { shortname <- paste(shortname, "_", band(object)) }
object at file@shortname <- shortname
object at file@gdalhandle <- list()
}
Added: pkg/raster/R/writeAscii.R
===================================================================
--- pkg/raster/R/writeAscii.R (rev 0)
+++ pkg/raster/R/writeAscii.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -0,0 +1,53 @@
+
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,1
+# Licence GPL v3
+
+
+
+.writeAscii <- function(raster, overwrite=FALSE) {
+ filename <- filename(raster)
+ if (dataIndices(raster)[1] == 1) {
+ resdif <- abs((yres(raster) - xres(raster)) / yres(raster) )
+ if (resdif > 0.01) {
+ stop(paste("raster has unequal horizontal and vertical resolutions","\n", "these data cannot be stored in arc-ascii format"))
+ }
+ if (!overwrite & file.exists(filename)) {
+ stop(paste(filename, "exists. Use 'overwrite=TRUE'"))
+ }
+
+ thefile <- file(filename, "w") # open an txt file connection
+ cat("NCOLS", ncol(raster), "\n", file = thefile)
+ cat("NROWS", nrow(raster), "\n", file = thefile)
+ cat("XLLCORNER", xmin(raster), "\n", file = thefile)
+ cat("YLLCORNER", ymin(raster), "\n", file = thefile)
+ cat("CELLSIZE", xres(raster), "\n", file = thefile)
+ cat("NODATA_value", .nodatavalue(raster), "\n", file = thefile)
+ close(thefile) #close connection
+
+ } else if ( dataIndices(raster)[2] > ncell(raster)) {
+ stop(paste('writing beyond end of file. last cell:', dataIndices(raster)[2], '>', ncell(raster)))
+ }
+
+
+ raster at data@values[is.na(values(raster))] <- .nodatavalue(raster)
+ if (dataContent(raster) == 'all') {
+ for (r in 1:nrow(raster)) {
+ write.table(t(valuesRow(raster, r)), filename, append = TRUE, quote = FALSE,
+ sep = " ", eol = "\n", dec = ".", row.names = FALSE, col.names = FALSE)
+ }
+ } else {
+ write.table(t(values(raster)), filename, append = TRUE, quote = FALSE,
+ sep = " ", eol = "\n", dec = ".", row.names = FALSE, col.names = FALSE)
+ }
+
+ if ( dataIndices(raster)[2] == ncell(raster)) {
+ return(rasterFromFile(filename))
+ } else {
+ return(raster)
+ }
+}
+
+
\ No newline at end of file
Added: pkg/raster/R/writeGDAL.R
===================================================================
--- pkg/raster/R/writeGDAL.R (rev 0)
+++ pkg/raster/R/writeGDAL.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -0,0 +1,178 @@
+# R function for the raster package
+# Author: Robert J. Hijmans
+# International Rice Research Institute. Philippines
+# contact: r.hijmans at gmail.com
+# Date : January 2009
+# Version 0.8
+# Licence GPL v3
+
+
+# based on create2GDAL and saveDataset from the rgdal package
+# authors: Timothy H. Keitt, Roger Bivand, Edzer Pebesma, Barry Rowlingson
+
+.isSupportedGDALdriver <- function(dname) {
+ gdrivers <- c("ADRG", "BMP", "BT", "EHdr", "ELAS", "ENVI", "ERS", "GSBG", "GTiff", "HFA", "IDA", "ILWIS", "INGR", "Leveller", "MEM", "MFF", "MFF2", "NITF", "PAux", "PCIDSK", "PNM", "RMF", "RST", "SGI", "Terragen", "VRT")
+ res <- dname %in% gdrivers
+ if (!res) { stop(paste(dname,"is not a supported GDAL file format. Choose from: \n ADRG, BMP, BT, EHdr, ELAS, ENVI, ERS, GSBG, GTiff, HFA, IDA, ILWIS,\n INGR, Leveller, MEM, MFF, MFF2, NITF, PAux, PCIDSK, PNM, RMF, RST, SGI, Terragen, VRT" ) ) }
+ return(res)
+}
+
+
+.getGDALtransient <- function(raster, gdalfiletype, overwrite, ForceIntOutput, mvFlag, options) {
+ .isSupportedGDALdriver(gdalfiletype)
+
+# this is a RasterLayer hence nbands = 1:
+ nbands = nlayers(raster)
+# but we keep this for later (stack, brick)
+
+ raster <- setFilename(raster, trim(filename(raster)))
+ if (filename(raster) == "") { stop('first provide a filename. E.g.: raster <- setFilename(raster, "c:/myfile")') }
+
+ if (file.exists( filename(raster) )) {
+ if (!overwrite) {
+ stop("filename exists; use overwrite=TRUE")
+ } else if (!file.remove( filename(raster) )) {
+ stop("cannot delete existing file. permissin denied.")
+ }
+ }
+
+#.GDALDataTypes <- c('Unknown', 'Byte', 'UInt16', 'Int16', 'UInt32','Int32', 'Float32', 'Float64', 'CInt16', 'CInt32', 'CFloat32', 'CFloat64')
+# this needs to get fancier; depending on object and the abilties of the drivers
+ if (dataType(raster) == 'integer' | ForceIntOutput) {
+ dataformat <- 'Int32'
+ if (raster at data@haveminmax) {
+ if (minValue(raster) > -32768 & maxValue(raster) <= 32767) {
+ dataformat <- 'Int16'
+ } # also check for the need for INT64
+ }
+ } else { dataformat <- 'Float32' }
+
+ driver = new("GDALDriver", gdalfiletype)
+
+ if (!is.null(options) && !is.character(options)) { stop("options not character") }
+ transient = new("GDALTransientDataset", driver = driver, rows = nrow(raster), cols = ncol(raster), bands = nbands, type = dataformat, options = options, handle = NULL)
+
+ gt <- c(xmin(raster), xres(raster), 0, ymax(raster), 0, -yres(raster))
+ .Call("RGDAL_SetGeoTransform", transient, gt, PACKAGE = "rgdal")
+ p4s <- projection(raster)
+ .Call("RGDAL_SetProject", transient, p4s, PACKAGE = "rgdal")
+
+ return(transient)
+}
+
+
+
+exportGDAL <- function(raster, filename, gdalfiletype = "GTiff", overwrite=FALSE, ForceIntOutput = FALSE ) {
+ mvFlag = NA
+ options = NULL
+ nbands = nlayers(raster)
+
+ outras <- setRaster(raster, filename)
+ transient <- .getGDALtransient(raster, gdalfiletype, overwrite, ForceIntOutput, mvFlag, options)
+
+ for (band in 1:nbands) {
+ if (dataContent(raster)=='all') {
+# if (!is.na(mvFlag)) vals[is.na(vals)] = mvFlag
+# This would work, but could potentially lead to memory problems (making a copy of the values before writing)
+# x <- putRasterData(transient, t(values(raster, format='matrix')), band, c(0, 0))
+ if (ForceIntOutput) {
+ for (r in 1:nrow(raster)) {
+ x <- putRasterData(transient, as.integer(round(valuesRow(raster, r))), band, c((r-1), 0))
+ }
+ } else {
+ for (r in 1:nrow(raster)) {
+ x <- putRasterData(transient, valuesRow(raster, r), band, c((r-1), 0))
+ }
+ }
+ } else {
+ if (dataSource(raster)=='ram') {
+ stop("No data on disk, and not all values in memory. Cannot write the file")
+ }
+ if (ForceIntOutput) {
+ for (r in 1:nrow(raster)) {
+ x <- putRasterData(transient, as.integer(round(values(readRow(raster, r)))), band, c((r-1), 0))
+ }
+ } else {
+ for (r in 1:nrow(raster)) {
+ x <- putRasterData(transient, values(readRow(raster, r)), band, c((r-1), 0))
+ }
+ }
+ }
+
+# if (!is.na(mvFlag)) {
+# transient_b <- getRasterBand(dataset = transient, band = band)
+# .Call("RGDAL_SetNoDataValue", transient_b, as.double(mvFlag), PACKAGE = "rgdal")
+# }
+ }
+ saveDataset(transient, outras at filename)
+ GDAL.close(transient)
+
+# do NOT do this, it removes the driver for future use!!! ????
+# GDAL.close(driverobj)
+ outras at data@min <- raster at data@min
+ outras at data@max <- raster at data@max
+ if (!is.na((outras at data@min))) { outras at data@haveminmax <- TRUE }
+ return(outras)
+}
+
+
+
+
+
+
+.writeGDALrow <- function(raster, gdalfiletype, overwrite, ForceIntOutput, mvFlag, options ) {
+
+ rownr <- rowFromCell(raster, dataIndices(raster)[1])
+ if ( rownr == 1) {
+ transient <- .getGDALtransient(raster, gdalfiletype, overwrite, ForceIntOutput, mvFlag, options)
+ attr(raster, "transient") <- transient
+ raster at data@min <- 3e34
+ raster at data@max <- -3e34
+ raster at data@haveminmax <- FALSE
+ raster at file@driver <- 'gdal'
+ raster at file@gdalhandle <- list()
+ }
+ for (band in 1:nlayers(raster)) {
+ x <- putRasterData(raster at transient, values(raster, rownr), band, c((rownr-1), 0))
+
+ rsd <- na.omit(raster at data@values) # min and max values; perhaps not worth it, as they won't be saved to file
+ if (length(rsd) > 0) {
+ raster at data@min <- min(raster at data@min, min(rsd))
+ raster at data@max <- max(raster at data@max, max(rsd))
+ }
+ }
+# if (!is.na(mvFlag)) {
+# transient_b <- getRasterBand(dataset = transient, band = band)
+# .Call("RGDAL_SetNoDataValue", transient_b, as.double(mvFlag), PACKAGE = "rgdal")
+# }
+ if ( rownr == nrow(raster)) {
+ saveDataset(raster at transient, filename(raster) )
+ GDAL.close(raster at transient)
+ raster <- rasterFromFile(filename(raster))
+
+ raster at data@haveminmax <- TRUE
+ raster at data@source <- 'disk'
+ raster at data@content <- 'nodata'
+ raster at data@values <- vector(length=0)
+ }
+ return(raster)
+}
+
+
+.writeGDALall <- function(raster, gdalfiletype, overwrite, ForceIntOutput, mvFlag, options) {
+
+ transient <- .getGDALtransient(raster, gdalfiletype, overwrite, ForceIntOutput, mvFlag, options)
+ for (band in 1:nlayers(raster)) {
+ x <- putRasterData(transient, t(values(raster, format='matrix')), band, c(0, 0))
+ }
+# if (!is.na(mvFlag)) {
+# transient_b <- getRasterBand(dataset = transient, band = band)
+# .Call("RGDAL_SetNoDataValue", transient_b, as.double(mvFlag), PACKAGE = "rgdal")
+# }
+ saveDataset(transient, filename(raster) )
+ GDAL.close(transient)
+ tempras <- rasterFromFile(filename(raster) )
+ raster at file@gdalhandle <- tempras at file@gdalhandle
+ return(raster)
+}
+
Added: pkg/raster/R/writeRaster.R
===================================================================
--- pkg/raster/R/writeRaster.R (rev 0)
+++ pkg/raster/R/writeRaster.R 2009-01-20 02:55:24 UTC (rev 163)
@@ -0,0 +1,221 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,1
+# Licence GPL v3
+
+
+
+.setFileExtensionValues <- function(fname) {
+ fname <- setFileExtension(fname, ".gri")
+ return(fname)
+}
+
+.setFileExtensionHeader <- function(fname) {
+ fname <- setFileExtension(fname, ".grd")
+ return(fname)
+}
+
+
+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)
+ } else {
+ raster <- .writeRasterAll(raster, overwrite)
+ }
+ } else if (format=='ascii') {
+ raster <- .writeAscii(raster, overwrite)
+ } else {
+ mvFlag = NA
+ options = NULL
+ ForceIntOutput = FALSE
+ if (dataContent(raster) == 'row' ) {
+ raster <- .writeGDALrow(raster, format, overwrite, ForceIntOutput, mvFlag, options)
+ } else {
+ raster <- .writeGDALall(raster, format, overwrite, ForceIntOutput, mvFlag, options)
+ }
+ }
+ return(raster)
+}
+
+
+
+
+.writeRasterAll <- function(raster, overwrite=FALSE) {
+ raster <- setFilename(raster, .setFileExtensionHeader(filename(raster)))
+ if (filename(raster) == "") {
+ stop('first provide a filename. E.g.: raster <- setFilename(raster, "c:/myfile")')
+ }
+ if (!overwrite & file.exists(filename(raster))) {
+ stop(paste(filename(raster),"exists.","use 'overwrite=TRUE' if you want to overwrite it"))
+ }
+ raster at file@driver <- 'raster'
+ raster at file@gdalhandle <- list()
+ raster at data@values[is.nan(raster at data@values)] <- NA
+ raster at data@values[is.infinite(raster at data@values)] <- NA
+ raster <- setMinMax(raster)
+
+ if ( raster at file@datatype =='integer') {
+ if (xmin(raster) > -32767 & xmax(raster) < 32768) {
+ raster <- setDatatype(raster, 'integer', datasize=2)
+ raster at data@values <- as.integer(round(values(raster)))
+ } else if (xmin(raster) > -2147483647 & xmax(raster) < 2147483648 ) {
+ raster <- setDatatype(raster, 'integer', datasize=4)
+ raster at data@values <- as.integer(round(values(raster)))
+ } else if (xmin(raster) > -(2^63/2) & xmax(raster) < (2^64/2)) {
+ raster <- setDatatype(raster, 'integer', datasize=8)
+ raster at data@values <- as.integer(round(values(raster)))
+ } else {
+ raster <- setDatatype(raster, 'numeric', datasize=8)
+ raster at data@values <- as.numeric(values(raster))
+ }
+ } else {
+ if (xmin(raster) < -3.4E38 | xmax(raster) > 3.4E38) {
+ raster <- setDatatype(raster, 'numeric', 8)
+ } else {
+ raster <- setDatatype(raster, 'numeric', 4)
+ }
+ }
+
+ if (raster at data@content == 'sparse') {
+ raster <- .writeSparse(raster, overwrite)
+ } else {
+ binraster <- .setFileExtensionValues(filename(raster))
+ con <- file(binraster, "wb")
+ writeBin( values(raster), con, size = raster at file@datasize)
+ close(con)
+ .writeRasterHdr(raster)
+ }
+ return(raster)
+}
+
+
+
+.writeRasterRow <- function(raster, overwrite=FALSE) {
+ if (dataContent(raster) != 'row') { stop('raster does not contain a row') }
+
+ if (dataIndices(raster)[1] == 1) {
+ # FIRST ROW
+ raster <- setFilename(raster, .setFileExtensionHeader(filename(raster)))
+ if (filename(raster) == "") {
+ stop('first provide a filename. E.g.: raster <- setFilename(raster, "c:/myfile")')
+ }
+ if (!overwrite & file.exists(filename(raster))) {
+ stop(paste(filename(raster),"exists.","use 'overwrite=TRUE' if you want to overwrite it"))
+ }
+ raster at file@name <- .setFileExtensionHeader(filename(raster))
+ binraster <- .setFileExtensionValues(filename(raster))
+ attr(raster, "filecon") <- file(binraster, "wb")
+ raster at data@min <- 3e34
+ raster at data@max <- -3e34
+ raster at data@haveminmax <- FALSE
+ raster at file@driver <- 'raster'
+ raster at file@gdalhandle <- list()
+ }
+
+ if (raster at file@datatype == "integer") { raster at data@values <- as.integer(round(raster at data@values)) }
+ if (class(values(raster)) == "integer" & raster at file@datatype == "numeric") { raster at data@values <- as.numeric(values(raster)) }
+
+ raster at data@values[is.nan(raster at data@values)] <- NA
+ raster at data@values[is.infinite(raster at data@values)] <- NA
+ rsd <- na.omit(raster at data@values) # min and max values
+ if (length(rsd) > 0) {
+ raster at data@min <- min(raster at data@min, min(rsd))
+ raster at data@max <- max(raster at data@max, max(rsd))
+ }
+
+# raster at data@values[is.na(raster at data@values)] <- raster at file@nodatavalue
+ writeBin(as.vector(raster at data@values), raster at filecon, size = raster at file@datasize)
+
+ if (dataIndices(raster)[2] == ncell(raster)) {
+ # LAST ROW
+ .writeRasterHdr(raster)
+ close(raster at filecon)
+ raster at data@haveminmax <- TRUE
+ raster at data@source <- 'disk'
+ raster at data@content <- 'nodata'
+ raster at data@values <- vector(length=0)
+ }
+ if (dataIndices(raster)[2] > ncell(raster)) {
+ stop(paste('writing beyond end of file. last cell:', dataIndices(raster)[2], '>', ncell(raster)))
+ }
+ return(raster)
+}
+
+
+.writeSparse <- function(raster, overwrite=FALSE) {
+
+ raster at file@driver <- 'raster'
+ raster at file@gdalhandle <- list()
+ raster <- setFilename(raster, .setFileExtensionHeader(filename(raster)))
+ if (!overwrite & file.exists(filename(raster))) {
+ stop(paste(filename(raster), "exists. Use 'overwrite=TRUE' if you want to overwrite it"))
+ }
+
+ raster at data@values[is.nan(values(raster))] <- NA
+ if (raster at file@datatype == "integer") {
+ raster at data@values <- as.integer(values(raster))
+ }
+ if (class(values(raster))=='integer') {
+ raster <- setDatatype(raster, 'integer')
+ }
+ raster <- setMinMax(raster)
+
+ binraster <- .setFileExtensionValues(filename(raster))
+ con <- file(binraster, "wb")
+ writeBin( as.vector(dataIndices(raster)), con, size = as.integer(4))
+ writeBin( as.vector(values(raster)), con, size = raster at file@datasize)
+ close(con)
+
+ # add the 'sparse' key word to the hdr file!!!
+ .writeRasterHdr(raster)
+ return(raster)
+}
+
+
+.writeRasterHdr <- function(raster) {
+ rastergrd <- .setFileExtensionHeader(filename(raster))
+ thefile <- file(rastergrd, "w") # open an txt file connectionis
+ cat("[general]", "\n", file = thefile)
+ cat("creator=R package:raster", "\n", file = thefile)
+ cat("created=", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n", file = thefile)
+ cat("title=", raster at file@shortname, "\n", file = thefile)
+ cat("[georeference]", "\n", file = thefile)
+ cat("nrows=", nrow(raster), "\n", file = thefile)
+ cat("ncols=", ncol(raster), "\n", file = thefile)
+ cat("xmin=", xmin(raster), "\n", file = thefile)
+ cat("ymin=", ymin(raster), "\n", file = thefile)
+ cat("xmax=", xmax(raster), "\n", file = thefile)
+ cat("ymax=", ymax(raster), "\n", file = thefile)
+ cat("xres=", xres(raster), "\n", file = thefile)
+ cat("yres=", yres(raster), "\n", file = thefile)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 163
More information about the Raster-commits
mailing list