[Raster-commits] r350 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 13 13:56:52 CET 2009
Author: rhijmans
Date: 2009-03-13 13:56:52 +0100 (Fri, 13 Mar 2009)
New Revision: 350
Added:
pkg/raster/R/aaaClasses.R
pkg/raster/R/raster.R
pkg/raster/R/rasterFromFile.R
Removed:
pkg/raster/R/all.classes.R
pkg/raster/R/raster.create.R
Modified:
pkg/raster/R/depracated.R
pkg/raster/R/pointdistance.R
pkg/raster/man/pointdistance.Rd
pkg/raster/man/project.Rd
pkg/raster/man/raster.Rd
pkg/raster/man/resample.Rd
pkg/raster/man/writeadvanced.Rd
Log:
Added: pkg/raster/R/aaaClasses.R
===================================================================
--- pkg/raster/R/aaaClasses.R (rev 0)
+++ pkg/raster/R/aaaClasses.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -0,0 +1,200 @@
+# R classes for spatial data (raster data specifically)
+# Authors: Robert J. Hijmans and Jacob van Etten,
+# International Rice Research Institute. Philippines
+# contact: r.hijmans at gmail.com
+# Date : November 2008
+# Version 0.8
+# Licence GPL v3
+
+
+setClass('BoundingBox',
+ representation (
+ xmin = 'numeric',
+ xmax = 'numeric',
+ ymin = 'numeric',
+ ymax = 'numeric'
+ ),
+ prototype (
+ xmin = 0,
+ xmax = 1,
+ ymin = 0,
+ ymax = 1
+ ),
+ validity = function(object) {
+ c1 <- (object at xmin <= object at xmax)
+ if (!c1) { stop('xmin > xmax') }
+ c2 <- (object at ymin <= object at ymax)
+ if (!c2) { stop('ymin > ymax') }
+ v <- c(object at xmin, object at xmax, object at ymin, object at ymax)
+ c3 <- all(!is.infinite(v))
+ if (!c3) { stop('infinite in BoundingBox') }
+ return(c1 & c2 & c3)
+ }
+)
+
+
+setClass ('BasicRaster',
+ representation (
+ bbox = 'BoundingBox',
+ ncols ='integer',
+ nrows ='integer',
+ crs = 'CRS'
+ ),
+ prototype (
+ ncols= as.integer(1),
+ nrows= as.integer(1),
+ crs = CRS(as.character(NA))
+ ),
+ validity = function(object) {
+ validObject(getBbox(object))
+ c1 <- (object at ncols > 0)
+ if (!c1) { stop('ncols < 1') }
+ c2 <- (object at nrows > 0)
+ if (!c2) { stop('nrows < 1') }
+ return(c1 & c2)
+ }
+)
+
+setClass ('Raster', contains = c('BasicRaster', 'VIRTUAL') )
+
+
+setClass('RasterFile',
+ representation (
+ name ='character',
+ shortname ='character', # short name
+ driver ='character', #gdal, raster
+ gdalhandle='list',
+# datatype ='character', #'numeric' or 'integer'
+# datasize ='integer',
+# datasigned='logical',
+ datanotation='character',
+ byteorder ='character',
+ nodatavalue ='numeric', # on disk, in ram it is NA
+ nbands ='integer',
+ band = 'integer',
+ bandorder ='character'
+ ),
+ prototype (
+ name = '',
+ shortname ='',
+ driver = 'raster',
+ gdalhandle= list(),
+# datatype = 'numeric',
+# datasize = as.integer(4),
+# datasigned= TRUE,
+ datanotation='FLT4S',
+ byteorder = .Platform$endian,
+ nodatavalue = -9999,
+ nbands = as.integer(1),
+ band = as.integer(1),
+ bandorder = 'BIL'
+ ),
+ validity = function(object) {
+ c1 <- datanotation %in% c('LOG1S', 'INT1S', 'INT2S', 'INT4S', 'INT8S', 'INT1U', 'INT2U', 'INT4U', 'INT8U', 'FLT4S', 'FLT8S')
+ return(c1)
+ }
+)
+
+
+setClass('SingleLayerData',
+ representation (
+ values='vector',
+ content='character', #nodata, all, row, block, sparse
+ indices = 'vector',
+ colname = 'character',
+ haveminmax = 'logical',
+ min = 'vector',
+ max = 'vector',
+ source='character' # ram, disk
+ ),
+ prototype (
+ values=vector(),
+ content='nodata',
+ indices = vector(mode='numeric'),
+ colname = '',
+ haveminmax = FALSE,
+ min = c(Inf),
+ max = c(-Inf),
+ source='ram'
+ ),
+ validity = function(object) {
+ }
+)
+
+
+
+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',
+ content='character', #nodata, all, row, block, sparse
+ indices = 'vector',
+ colnames = 'vector',
+ nlayers='integer',
+ haveminmax = 'logical',
+ min = 'vector',
+ max = 'vector'
+ ),
+ prototype (
+ values=matrix(NA,0,0),
+ content='nodata',
+ indices =vector(mode='numeric'),
+ colnames =vector(mode='character'),
+ nlayers=as.integer(0),
+ haveminmax = FALSE,
+ min = c(Inf),
+ max = c(-Inf)
+ ),
+ validity = function(object) {
+ }
+)
+
+
+
+
+setClass ('RasterStack',
+ contains = 'Raster',
+ representation (
+ filename ='character',
+ layers ='list',
+ data = 'MultipleRasterData'
+ ),
+ prototype (
+ filename='',
+ layers = list()
+ ),
+ validity = function(object) {
+ cond1 <- length(object at layers) == object at data@nlayers
+ cond <- cond1
+ return(cond)
+ }
+)
+
Deleted: pkg/raster/R/all.classes.R
===================================================================
--- pkg/raster/R/all.classes.R 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/R/all.classes.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -1,200 +0,0 @@
-# R classes for spatial data (raster data specifically)
-# Authors: Robert J. Hijmans and Jacob van Etten,
-# International Rice Research Institute. Philippines
-# contact: r.hijmans at gmail.com
-# Date : November 2008
-# Version 0.8
-# Licence GPL v3
-
-
-setClass('BoundingBox',
- representation (
- xmin = 'numeric',
- xmax = 'numeric',
- ymin = 'numeric',
- ymax = 'numeric'
- ),
- prototype (
- xmin = 0,
- xmax = 1,
- ymin = 0,
- ymax = 1
- ),
- validity = function(object) {
- c1 <- (object at xmin <= object at xmax)
- if (!c1) { stop('xmin > xmax') }
- c2 <- (object at ymin <= object at ymax)
- if (!c2) { stop('ymin > ymax') }
- v <- c(object at xmin, object at xmax, object at ymin, object at ymax)
- c3 <- all(!is.infinite(v))
- if (!c3) { stop('infinite in BoundingBox') }
- return(c1 & c2 & c3)
- }
-)
-
-
-setClass ('BasicRaster',
- representation (
- bbox = 'BoundingBox',
- ncols ='integer',
- nrows ='integer',
- crs = 'CRS'
- ),
- prototype (
- ncols= as.integer(1),
- nrows= as.integer(1),
- crs = CRS(as.character(NA))
- ),
- validity = function(object) {
- validObject(getBbox(object))
- c1 <- (object at ncols > 0)
- if (!c1) { stop('ncols < 1') }
- c2 <- (object at nrows > 0)
- if (!c2) { stop('nrows < 1') }
- return(c1 & c2)
- }
-)
-
-setClass ('Raster', contains = c('BasicRaster', 'VIRTUAL') )
-
-
-setClass('RasterFile',
- representation (
- name ='character',
- shortname ='character', # short name
- driver ='character', #gdal, raster
- gdalhandle='list',
-# datatype ='character', #'numeric' or 'integer'
-# datasize ='integer',
-# datasigned='logical',
- datanotation='character',
- byteorder ='character',
- nodatavalue ='numeric', # on disk, in ram it is NA
- nbands ='integer',
- band = 'integer',
- bandorder ='character'
- ),
- prototype (
- name = '',
- shortname ='',
- driver = 'raster',
- gdalhandle= list(),
-# datatype = 'numeric',
-# datasize = as.integer(4),
-# datasigned= TRUE,
- datanotation='FLT4S',
- byteorder = .Platform$endian,
- nodatavalue = -9999,
- nbands = as.integer(1),
- band = as.integer(1),
- bandorder = 'BIL'
- ),
- validity = function(object) {
- c1 <- datanotation %in% c('LOG1S', 'INT1S', 'INT2S', 'INT4S', 'INT8S', 'INT1U', 'INT2U', 'INT4U', 'INT8U', 'FLT4S', 'FLT8S')
- return(c1)
- }
-)
-
-
-setClass('SingleLayerData',
- representation (
- values='vector',
- content='character', #nodata, all, row, block, sparse
- indices = 'vector',
- colname = 'character',
- haveminmax = 'logical',
- min = 'vector',
- max = 'vector',
- source='character' # ram, disk
- ),
- prototype (
- values=vector(),
- content='nodata',
- indices = vector(mode='numeric'),
- colname = '',
- haveminmax = FALSE,
- min = c(Inf),
- max = c(-Inf),
- source='ram'
- ),
- validity = function(object) {
- }
-)
-
-
-
-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',
- content='character', #nodata, all, row, block, sparse
- indices = 'vector',
- colnames = 'vector',
- nlayers='integer',
- haveminmax = 'logical',
- min = 'vector',
- max = 'vector'
- ),
- prototype (
- values=matrix(NA,0,0),
- content='nodata',
- indices =vector(mode='numeric'),
- colnames =vector(mode='character'),
- nlayers=as.integer(0),
- haveminmax = FALSE,
- min = c(Inf),
- max = c(-Inf)
- ),
- validity = function(object) {
- }
-)
-
-
-
-
-setClass ('RasterStack',
- contains = 'Raster',
- representation (
- filename ='character',
- layers ='list',
- data = 'MultipleRasterData'
- ),
- prototype (
- filename='',
- layers = list()
- ),
- validity = function(object) {
- cond1 <- length(object at layers) == object at data@nlayers
- cond <- cond1
- return(cond)
- }
-)
-
Modified: pkg/raster/R/depracated.R
===================================================================
--- pkg/raster/R/depracated.R 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/R/depracated.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -1,4 +1,9 @@
+#newRaster <- function(xmn=-180, xmx=180, ymn=-90, ymx=90, nrows=180, ncols=360, projstring="+proj=longlat +datum=WGS84") {
+# stop("'newRaster' is deprecated. Use 'raster' instead")
+#}
+
+
# no longer used. Use calc instead. See ?calc
Modified: pkg/raster/R/pointdistance.R
===================================================================
--- pkg/raster/R/pointdistance.R 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/R/pointdistance.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -6,8 +6,11 @@
distanceEuclidean <- function (point1, point2) {
#some checks
- if ( (!is.vector(point1) & !is.matrix(point1)) | (!is.vector(point2) & !is.matrix(point2)) ) {stop('points can only be supplied vectors of length 2 or matrices with 2 columns')}
+ if ( (!is.vector(point1) & !is.matrix(point1)) | (!is.vector(point2) & !is.matrix(point2)) ) {
+ stop('points can only be supplied vectors of length 2 or matrices with 2 columns')
+ }
+
if(is.vector(point1)){
if (length(point1) != 2) {stop('wrong length: point1 can only be a vector of length 2 or a matrix with 2 columns')}
}
@@ -24,11 +27,21 @@
if(length(point1[,1]) != length(point2[,1]))
{stop('when point1 and point2 are both matrices they should have the same number of rows')}
}
+
+ if(is.vector(point1)){ point1 <- matrix(point1, ncol=2) }
+ if(is.vector(point2)){ point2 <- matrix(point1, ncol=2) }
+ x1 <- point1[,1]
+ y1 <- point1[,2]
+ x2 <- point2[,1]
+ y2 <- point2[,2]
+
distance <- sqrt((x1 - x2)^2 + (y1 - y2)^2)
return(distance)
}
+
+
distanceGreatcircle <- function (point1, point2, r=6378137) {
# some checks
if ( (!is.vector(point1) & !is.matrix(point1)) | (!is.vector(point2) & !is.matrix(point2)) ) {stop('points can only be supplied vectors of length 2 or matrices with 2 columns')}
@@ -54,27 +67,14 @@
point1 <- point1 * pi / 180
point2 <- point2 * pi / 180
- #prepare x1,x2,y1,y2
- if(is.vector(point1)){
- x1 <- point1[1]
- y1 <- point1[2]
- }
+ if(is.vector(point1)){ point1 <- matrix(point1, ncol=2) }
+ if(is.vector(point2)){ point2 <- matrix(point1, ncol=2) }
- if(is.vector(point2)){
- x2 <- point2[1]
- y2 <- point2[2]
- }
+ x1 <- point1[,1]
+ y1 <- point1[,2]
+ x2 <- point2[,1]
+ y2 <- point2[,2]
- if(is.matrix(point1)){
- x1 <- point1[,1]
- y1 <- point1[,2]
- }
-
- if(is.matrix(point2)){
- x2 <- point2[,1]
- y2 <- point2[,2]
- }
-
# cosd <- sin(y1) * sin(y2) + cos(y1) * cos(y2) * cos(x1-x2);
# distance <- r * acos(cosd);
# the following is supposedly more precise than above (http://en.wikipedia.org/wiki/Great_circle_distance):
Added: pkg/raster/R/raster.R
===================================================================
--- pkg/raster/R/raster.R (rev 0)
+++ pkg/raster/R/raster.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -0,0 +1,74 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+
+
+
+rasterFromFile <- function(filename, values=FALSE, band=1) {
+ warning("'rasterFromFile' is deprecated. Use 'raster(filename)' instead")
+
+ fileext <- toupper(fileExtension(filename))
+ if ( fileext == ".GRD" | fileext == ".GRI" ) {
+ raster <- .rasterFromRasterFile(filename, band)
+ } else {
+ raster <- .rasterFromGDAL(filename, band)
+ }
+ if (values) {
+ raster <- readAll(raster)
+ }
+ return(raster)
+}
+
+
+
+if (!isGeneric("raster")) {
+ setGeneric("raster", function(x, ...)
+ standardGeneric("raster"))
+}
+
+
+setMethod('raster', signature(x='missing'),
+ function(nrows=180, ncols=360, xmn=-180, xmx=180, ymn=-90, ymx=90, projstring="+proj=longlat +datum=WGS84") {
+ bb <- newBbox(xmn, xmx, ymn, ymx)
+ rs <- raster(bb, nrows=nrows, ncols=ncols)
+ rs <- setProjection(rs, projstring)
+ return(rs)
+ }
+)
+
+
+setMethod('raster', signature(x='Raster'),
+ function(x, ...) {
+ return(setRaster(x))
+ }
+)
+
+
+setMethod('raster', signature(x='character'),
+ function(x, values=FALSE, band=1) {
+ return(rasterFromFile(x, values=values, band=band))
+ }
+)
+
+
+
+setMethod('raster', signature(x='BoundingBox'),
+function(x, nrows=10, ncols=10) {
+ crs <- newCRS('NA')
+ try(crs <- projection(x, asText=F), silent = T)
+
+ bb <- getBbox(x)
+
+ nr = as.integer(round(nrows))
+ nc = as.integer(round(ncols))
+ if (nc < 1) { stop("ncols should be > 0") }
+ if (nr < 1) { stop("nrows should be > 0") }
+ raster <- new("RasterLayer", bbox = bb, crs=crs, ncols = nc, nrows = nr )
+ return(raster)
+}
+)
Deleted: pkg/raster/R/raster.create.R
===================================================================
--- pkg/raster/R/raster.create.R 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/R/raster.create.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -1,188 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0.8
-# Licence GPL v3
-
-
-closeHandle <- function(raster) {
-# if handle = gdal then gdalclose the handle
- if (.driver(raster) == "gdal") {
- closeDataset(raster at file@gdalhandle[[1]])
- raster at file@gdalhandle[[1]] <- list()
- } else {
- cr <- try(close(raster at filecon), silent = T)
- }
- return(raster)
-}
-
-
-#newRaster <- function(xmn=-180, xmx=180, ymn=-90, ymx=90, nrows=180, ncols=360, projstring="+proj=longlat +datum=WGS84") {
-# warning("'newRaster' is deprecated. Use 'raster' instead")
-# return(raster(xmn, xmx, ymn, ymx, nrows, ncols, projstring)) }
-
-
-raster <- function(nrows=180, ncols=360, xmn=-180, xmx=180, ymn=-90, ymx=90, projstring="+proj=longlat +datum=WGS84") {
- bb <- newBbox(xmn, xmx, ymn, ymx)
- rs <- rasterFromBbox(bb, nrows=nrows, ncols=ncols)
- rs <- setProjection(rs, projstring)
- return(rs)
-}
-
-#if (!isGeneric("raster")) {
-# setGeneric("raster", function(x, ...)
-# standardGeneric("raster"))
-#}
-
-#setMethod('raster', signature(x='Raster'),
-# function(x, ...) {
-# return(setRaster(x))
-#}
-
-
-rasterFromBbox <- function(bndbox, nrows=10, ncols=10) {
- crs <- newCRS('NA')
- try(crs <- projection(bndbox, asText=F), silent = T)
- bb <- getBbox(bndbox)
-
- nr = as.integer(round(nrows))
- nc = as.integer(round(ncols))
- if (nc < 1) { stop("ncols should be > 0") }
- if (nr < 1) { stop("nrows should be > 0") }
- raster <- new("RasterLayer", bbox = bb, crs=crs, ncols = nc, nrows = nr )
- return(raster)
-}
-
-rasterFromFile <- function(filename, values=FALSE, band=1) {
- fileext <- toupper(fileExtension(filename))
- if ( fileext == ".GRD" | fileext == ".GRI" ) {
- raster <- .rasterFromRasterFile(filename, band)
- } else {
- raster <- .rasterFromGDAL(filename, band)
- }
- if (values) {
- raster <- readAll(raster)
- }
- return(raster)
-}
-
-.rasterFromGDAL <- function(filename, band) {
- gdalinfo <- GDALinfo(filename)
- nc <- as.integer(gdalinfo[["columns"]])
- nr <- as.integer(gdalinfo[["rows"]])
- xn <- gdalinfo[["ll.x"]]
- if (xn < 0) { ndecs <- 9 } else { ndecs <- 8 }
- xn <- as.numeric( substr( as.character(xn), 1, ndecs) )
-
- xx <- xn + gdalinfo[["res.x"]] * nc
- if (xx < 0) { ndecs <- 9 } else { ndecs <- 8 }
- xx <- as.numeric( substr( as.character(xx), 1, ndecs) )
-
-# gdalv <- (packageDescription(pkg = "rgdal")$Version)
-# dif <- compareVersion(gdalv, "0.5-32")
-# if (dif < 0) {
-# yx <- gdalinfo[["ll.y"]]
-# yn <- yx - gdalinfo[["res.y"]] * nr
-# } else {
- yn <- gdalinfo[["ll.y"]]
- yx <- yn + gdalinfo[["res.y"]] * nr
-# }
-
- if (yn < 0) { ndecs <- 9 } else { ndecs <- 8 }
- yn <- as.numeric( substr( as.character(yn), 1, ndecs) )
- if (yx < 0) { ndecs <- 9 } else { ndecs <- 8 }
- yx <- as.numeric( substr( as.character(yx), 1, ndecs) )
-
- raster <- raster(ncols=nc, nrows=nr, xmn=xn, ymn=yn, xmx=xx, ymx=yx, projstring="")
- raster <- setFilename(raster, filename)
- raster <- setDatatype(raster, "FLT4S")
-
-
- raster at file@driver <- 'gdal'
- #attr(gdalinfo, "driver")
-
- raster at file@nbands <- as.integer(gdalinfo[["bands"]])
- band <- as.integer(band)
- if (band > nbands(raster) ) {
- warning("band too high. Set to nbands")
- band <- nbands(raster) }
- if ( band < 1) {
- warning("band too low. Set to 1")
- band <- 1 }
- raster at file@band <- as.integer(band)
-
- raster <- setProjection(raster, attr(gdalinfo, "projection"))
-
- raster at file@gdalhandle[1] <- GDAL.open(filename)
-#oblique.x 0 #oblique.y 0
- raster at data@source <- 'disk'
- return(raster)
-}
-
-
-
-.rasterFromRasterFile <- function(filename, band=1) {
- if (!file.exists( .setFileExtensionValues(filename)) ){
- warning("no '.gri' file. Assuming this is a Surfer file")
- return(.readSurfer6(filename))
- }
- ini <- readIniFile(filename)
- ini[,2] = toupper(ini[,2])
-
- byteorder <- .Platform$endian
- nbands <- as.integer(1)
- band <- as.integer(1)
- bandorder <- "BSQ"
- ncellvals <- -9
- projstring <- ""
- minval <- NA
- maxval <- NA
-
- for (i in 1:length(ini[,1])) {
- if (ini[i,2] == "MINX") {xn <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "MAXX") {xx <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "MINY") {yn <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "MAXY") {yx <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "XMIN") {xn <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "XMAX") {xx <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "YMIN") {yn <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "YMAX") {yx <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "ROWS") {nr <- as.integer(ini[i,3])}
- else if (ini[i,2] == "COLUMNS") {nc <- as.integer(ini[i,3])}
- else if (ini[i,2] == "NROWS") {nr <- as.integer(ini[i,3])}
- else if (ini[i,2] == "NCOLS") {nc <- as.integer(ini[i,3])}
- else if (ini[i,2] == "MINVALUE") {minval <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "MAXVALUE") {maxval <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "NODATAVALUE") {nodataval <- as.numeric(ini[i,3])}
- else if (ini[i,2] == "DATATYPE") {inidatatype <- ini[i,3]}
- else if (ini[i,2] == "BYTEORDER") {byteorder <- ini[i,3]}
- else if (ini[i,2] == "NBANDS") {nbands <- ini[i,3]}
- else if (ini[i,2] == "BANDORDER") {bandorder <- ini[i,3]}
-# else if (ini[i,2] == "NCELLVALS") {ncellvals <- ini[i,3]}
- else if (ini[i,2] == "PROJECTION") {projstring <- ini[i,3]}
- }
-
- raster <- raster(ncols=nc, nrows=nr, xmn=xn, ymn=yn, xmx=xx, ymx=yx, projstring=projstring)
- raster <- setFilename(raster, filename)
- raster at file@driver <- "raster"
-
- raster at data@min <- minval
- raster at data@max <- maxval
- raster at data@haveminmax <- TRUE
- raster at file@nodatavalue <- nodataval
-
- 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)
- # check if 0 < band <= nbands
- raster at file@bandorder <- bandorder
- # check if in ("BSQ", "BIP", "BIL")
-# raster at data@ncellvals <- as.integer(ncellvals)
-
- raster at data@source <- 'disk'
- return(raster)
-}
-
-
Added: pkg/raster/R/rasterFromFile.R
===================================================================
--- pkg/raster/R/rasterFromFile.R (rev 0)
+++ pkg/raster/R/rasterFromFile.R 2009-03-13 12:56:52 UTC (rev 350)
@@ -0,0 +1,139 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+closeHandle <- function(raster) {
+# if handle = gdal then gdalclose the handle
+ if (.driver(raster) == "gdal") {
+ closeDataset(raster at file@gdalhandle[[1]])
+ raster at file@gdalhandle[[1]] <- list()
+ } else {
+ cr <- try(close(raster at filecon), silent = T)
+ }
+ return(raster)
+}
+
+
+.rasterFromGDAL <- function(filename, band) {
+ gdalinfo <- GDALinfo(filename)
+ nc <- as.integer(gdalinfo[["columns"]])
+ nr <- as.integer(gdalinfo[["rows"]])
+ xn <- gdalinfo[["ll.x"]]
+ if (xn < 0) { ndecs <- 9 } else { ndecs <- 8 }
+ xn <- as.numeric( substr( as.character(xn), 1, ndecs) )
+
+ xx <- xn + gdalinfo[["res.x"]] * nc
+ if (xx < 0) { ndecs <- 9 } else { ndecs <- 8 }
+ xx <- as.numeric( substr( as.character(xx), 1, ndecs) )
+
+# gdalv <- (packageDescription(pkg = "rgdal")$Version)
+# dif <- compareVersion(gdalv, "0.5-32")
+# if (dif < 0) {
+# yx <- gdalinfo[["ll.y"]]
+# yn <- yx - gdalinfo[["res.y"]] * nr
+# } else {
+ yn <- gdalinfo[["ll.y"]]
+ yx <- yn + gdalinfo[["res.y"]] * nr
+# }
+
+ if (yn < 0) { ndecs <- 9 } else { ndecs <- 8 }
+ yn <- as.numeric( substr( as.character(yn), 1, ndecs) )
+ if (yx < 0) { ndecs <- 9 } else { ndecs <- 8 }
+ yx <- as.numeric( substr( as.character(yx), 1, ndecs) )
+
+ raster <- raster(ncols=nc, nrows=nr, xmn=xn, ymn=yn, xmx=xx, ymx=yx, projstring="")
+ raster <- setFilename(raster, filename)
+ raster <- setDatatype(raster, "FLT4S")
+
+
+ raster at file@driver <- 'gdal'
+ #attr(gdalinfo, "driver")
+
+ raster at file@nbands <- as.integer(gdalinfo[["bands"]])
+ band <- as.integer(band)
+ if (band > nbands(raster) ) {
+ warning("band too high. Set to nbands")
+ band <- nbands(raster) }
+ if ( band < 1) {
+ warning("band too low. Set to 1")
+ band <- 1 }
+ raster at file@band <- as.integer(band)
+
+ raster <- setProjection(raster, attr(gdalinfo, "projection"))
+
+ raster at file@gdalhandle[1] <- GDAL.open(filename)
+#oblique.x 0 #oblique.y 0
+ raster at data@source <- 'disk'
+ return(raster)
+}
+
+
+
+.rasterFromRasterFile <- function(filename, band=1) {
+ if (!file.exists( .setFileExtensionValues(filename)) ){
+ warning("no '.gri' file. Assuming this is a Surfer file")
+ return(.readSurfer6(filename))
+ }
+ ini <- readIniFile(filename)
+ ini[,2] = toupper(ini[,2])
+
+ byteorder <- .Platform$endian
+ nbands <- as.integer(1)
+ band <- as.integer(1)
+ bandorder <- "BSQ"
+ ncellvals <- -9
+ projstring <- ""
+ minval <- NA
+ maxval <- NA
+
+ for (i in 1:length(ini[,1])) {
+ if (ini[i,2] == "MINX") {xn <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "MAXX") {xx <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "MINY") {yn <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "MAXY") {yx <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "XMIN") {xn <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "XMAX") {xx <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "YMIN") {yn <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "YMAX") {yx <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "ROWS") {nr <- as.integer(ini[i,3])}
+ else if (ini[i,2] == "COLUMNS") {nc <- as.integer(ini[i,3])}
+ else if (ini[i,2] == "NROWS") {nr <- as.integer(ini[i,3])}
+ else if (ini[i,2] == "NCOLS") {nc <- as.integer(ini[i,3])}
+ else if (ini[i,2] == "MINVALUE") {minval <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "MAXVALUE") {maxval <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "NODATAVALUE") {nodataval <- as.numeric(ini[i,3])}
+ else if (ini[i,2] == "DATATYPE") {inidatatype <- ini[i,3]}
+ else if (ini[i,2] == "BYTEORDER") {byteorder <- ini[i,3]}
+ else if (ini[i,2] == "NBANDS") {nbands <- ini[i,3]}
+ else if (ini[i,2] == "BANDORDER") {bandorder <- ini[i,3]}
+# else if (ini[i,2] == "NCELLVALS") {ncellvals <- ini[i,3]}
+ else if (ini[i,2] == "PROJECTION") {projstring <- ini[i,3]}
+ }
+
+ raster <- raster(ncols=nc, nrows=nr, xmn=xn, ymn=yn, xmx=xx, ymx=yx, projstring=projstring)
+ raster <- setFilename(raster, filename)
+ raster at file@driver <- "raster"
+
+ raster at data@min <- minval
+ raster at data@max <- maxval
+ raster at data@haveminmax <- TRUE
+ raster at file@nodatavalue <- nodataval
+
+ 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)
+ # check if 0 < band <= nbands
+ raster at file@bandorder <- bandorder
+ # check if in ("BSQ", "BIP", "BIL")
+# raster at data@ncellvals <- as.integer(ncellvals)
+
+ raster at data@source <- 'disk'
+ return(raster)
+}
+
+
Modified: pkg/raster/man/pointdistance.Rd
===================================================================
--- pkg/raster/man/pointdistance.Rd 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/man/pointdistance.Rd 2009-03-13 12:56:52 UTC (rev 350)
@@ -35,8 +35,8 @@
\author{Robert J. Hijmans and Jacob van Etten }
\examples{
- a <- cbind(c(1,5,55,31),c(3,7,20))
- b <- cbind(c(4,2,8,65),c(50,-90,20))
+ a <- cbind(c(1,5,55,31),c(3,7,20,22))
+ b <- cbind(c(4,2,8,65),c(50,-90,20,32))
distanceEuclidean(c(0, 0), c(1, 1))
distanceGreatcircle(c(0, 0), c(1, 1))
Modified: pkg/raster/man/project.Rd
===================================================================
--- pkg/raster/man/project.Rd 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/man/project.Rd 2009-03-13 12:56:52 UTC (rev 350)
@@ -51,7 +51,7 @@
\examples{
# create a new (not projected) RasterLayer with cellnumbers as values
-r <- raster(-110, -90, 40, 60, ncols=40, nrows=30)
+r <- raster(xmn=-110, xmx=-90, ymn=40, ymx=60, ncols=40, nrows=30)
r <- setValues(r, 1:ncell(r))
# proj.4 projection description
newproj <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"
Modified: pkg/raster/man/raster.Rd
===================================================================
--- pkg/raster/man/raster.Rd 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/man/raster.Rd 2009-03-13 12:56:52 UTC (rev 350)
@@ -1,8 +1,12 @@
\name{raster}
\alias{raster}
-\alias{rasterFromBbox}
+\alias{raster,missing-method}
+\alias{raster,Raster-method}
+\alias{raster,character-method}
+\alias{raster,BoundingBox-method}
+
\title{Create a new RasterLayer object }
\description{
@@ -11,11 +15,20 @@
}
\usage{
-raster(nrows=180, ncols=360, xmn=-180, xmx=180, ymn=-90, ymx=90, projstring="+proj=longlat +datum=WGS84")
-rasterFromBbox(bndbox, nrows=10, ncols=10)
+raster(x, ...)
}
\arguments{
+ \item{x}{ many things... }
+ \item{...}{ even more things... }
+}
+
+\details{
+raster(nrows=180, ncols=360, xmn=-180, xmx=180, ymn=-90, ymx=90, projstring="+proj=longlat +datum=WGS84")
+raster(bndbox, nrows=10, ncols=10)
+raster(filename)
+raster(Raster* object)
+
\item{xmn}{minimum x coordinate or raster (left border) }
\item{xmx}{maximum x coordinate of raster (right border) }
\item{ymn}{minimum y coordinate or raster (bottom border) }
@@ -24,9 +37,9 @@
\item{ncols}{number of columns on raster }
\item{projstring}{PROJ4 type description of a map projection}
\item{bndbox}{bounding box used to crop a raster. Any object that is a BoundingBox object or contains one (such as Raster* objects)}
-}
-\details{
+
+
New RasterLayer objects have no values. You can set values with the \code{init} function or with a 'replacement function' (see example)
}
@@ -39,7 +52,8 @@
\examples{
r1 <- raster(nrows=108, ncols=21, xmn=0, xmx=10)
-r2 <- rasterFromBbox(r1)
+bb <- getBbox(r1)
+r2 <- raster(bb)
r2[] <- runif(ncell(r2))
}
Modified: pkg/raster/man/resample.Rd
===================================================================
--- pkg/raster/man/resample.Rd 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/man/resample.Rd 2009-03-13 12:56:52 UTC (rev 350)
@@ -39,9 +39,9 @@
\examples{
-r <- raster(4, 4)
+r <- raster(nrow=4, ncol=4)
r[] <- 1:ncell(r)
-r2 <- raster(40, 40)
+r2 <- raster(nrow=40, ncol=40)
s <- resample(r, r2, method='bilinear')
#plot(r)
#x11()
Modified: pkg/raster/man/writeadvanced.Rd
===================================================================
--- pkg/raster/man/writeadvanced.Rd 2009-03-13 09:06:46 UTC (rev 349)
+++ pkg/raster/man/writeadvanced.Rd 2009-03-13 12:56:52 UTC (rev 350)
@@ -37,9 +37,9 @@
\author{Robert J. Hijmans}
\examples{
-r <- raster(100, 100)
+r <- raster(nrow=100, ncol=100)
canProcessInMemory(r, 4)
-r <- raster(100000, 100000)
+r <- raster(nrow=100000, ncol=100000)
canProcessInMemory(r, 2)
}
More information about the Raster-commits
mailing list