[Raster-commits] r126 - in pkg/raster: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jan 13 04:57:44 CET 2009
Author: rhijmans
Date: 2009-01-13 04:57:43 +0100 (Tue, 13 Jan 2009)
New Revision: 126
Added:
pkg/raster/R/read.generic.R
pkg/raster/R/read.raster.R
pkg/raster/R/read.stack.R
pkg/raster/man/cell.values.Rd
Removed:
pkg/raster/R/generic.read.R
pkg/raster/R/raster.read.R
pkg/raster/R/stack.read.R
Modified:
pkg/raster/R/crop.R
pkg/raster/R/plot.R
pkg/raster/R/raster.write.R
pkg/raster/R/set.R
pkg/raster/R/set.values.R
pkg/raster/man/set.Rd
pkg/raster/man/values.Rd
Log:
Modified: pkg/raster/R/crop.R
===================================================================
--- pkg/raster/R/crop.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/crop.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -26,7 +26,7 @@
end_cells <- start_cells + ncol(outraster) - 1
selected_cells <- as.vector(mapply(seq, start_cells, end_cells))
outraster <- setValues(outraster, values(raster)[selected_cells])
- outraster <- setMinmax(outraster)
+ outraster <- setMinMax(outraster)
if (filename(outraster) != "" ) {
outraster <- try(writeRaster(outraster, overwrite=overwrite))
}
Deleted: pkg/raster/R/generic.read.R
===================================================================
--- pkg/raster/R/generic.read.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/generic.read.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -1,104 +0,0 @@
-# R function for the raster package
-# Author: Robert J. Hijmans
-# International Rice Research Institute. Philippines
-# contact: r.hijmans at gmail.com
-# Date : November 2008
-# Version 0.8
-# Licence GPL v3
-
-
-if (!isGeneric("readAll")) {
- setGeneric("readAll", function(object)
- standardGeneric("readAll"))
-}
-setMethod('readAll', signature(object='RasterLayer'),
- function(object){ return(.rasterRead(object, -1))}
-)
-setMethod('readAll', signature(object='RasterStack'),
- function(object){ return(.stackRead(object, -1))}
-)
-
-
-if (!isGeneric("readRow")) {
- setGeneric("readRow", function(object, rownr)
- standardGeneric("readRow"))
-}
-setMethod('readRow', signature(object='RasterLayer'),
- function(object, rownr){ return(.rasterRead(object, rownr))}
-)
-setMethod('readRow', signature(object='RasterStack'),
- function(object, rownr){ return(.stackRead(object, rownr))}
-)
-
-
-if (!isGeneric("readRows")) {
- setGeneric("readRows", function(object, startrow, nrows=3)
- standardGeneric("readRows"))
-}
-
-setMethod('readRows', signature(object='RasterLayer'),
- function(object, startrow, nrows=3) {
- #read multiple rows
- return(.rasterReadBlock(object, startrow, nrows))
- }
-)
-
-
-
-if (!isGeneric("readBlock")) {
- setGeneric("readBlock", function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1))
- standardGeneric("readBlock"))
-}
-
-setMethod('readBlock', signature(object='RasterLayer'),
- function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1)) {
- return(.rasterReadBlock(object, startrow, nrows, ncolumns))}
-)
-
-if (!isGeneric("readPartOfRow")) {
- setGeneric("readPartOfRow", function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1))
- standardGeneric("readPartOfRow"))
-}
-
-setMethod('readPartOfRow', signature(object='RasterLayer'),
- function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) {
- return(.rasterRead(object, rownr, startcol, ncolumns))}
-)
-
-setMethod('readPartOfRow', signature(object='RasterStack'),
- function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) {
- return( .stackRead(object, rownr, startcol, ncolumns) ) }
-)
-
-if (!isGeneric("cellValues")) {
- setGeneric("cellValues", function(object, cells)
- standardGeneric("cellValues"))
-}
-
-setMethod("cellValues", signature(object='RasterLayer'),
- function(object, cells) {
- return(.rasterReadCells(object, cells))}
-)
-
-
-setMethod("cellValues", signature(object='RasterStack'),
- function(object, cells) {
- return(.stackReadCells(object, cells))}
-)
-
-if (!isGeneric("xyValues")) {
- setGeneric("xyValues", function(object, xy)
- standardGeneric("xyValues"))
-}
-
-setMethod("xyValues", signature(object='RasterLayer'),
- function(object, xy) {
- return(.rasterReadXY(object, xy))
- }
-)
-
-setMethod("xyValues", signature(object='RasterStack'),
- function(object, xy) {
- return(.stackReadXY(object, xy))}
-)
-
Modified: pkg/raster/R/plot.R
===================================================================
--- pkg/raster/R/plot.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/plot.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -27,7 +27,7 @@
if (length(x) < nc) {
warning(paste('plot used a sample of ', round(100*length(x)/nc), "% of the cells", sep=""))
}
- plot(x, y, cex, ...)
+ plot(x, y, ...)
}
)
Deleted: pkg/raster/R/raster.read.R
===================================================================
--- pkg/raster/R/raster.read.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/raster.read.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -1,305 +0,0 @@
-# R code for reading raster (grid) data
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0,4
-# Licence GPL v3
-
-
-#read a block of data (a rectangular area of any dimension)
-.rasterReadBlock <- function(raster, startrow, nrows=3, startcol=1, ncolumns=(ncol(raster)-startcol+1)) {
- if (startrow < 1 ) { stop("startrow too small") }
- if (startrow > nrow(raster) ) { stop("startrow too high") }
- if (nrows < 1) { stop("nrows should be > 1") }
- if (startcol < 1) { stop("startcol < 1") }
- if (startcol > ncol(raster)) { stop("startcol > ncol(raster)") }
- if (ncolumns < 1) { stop("ncolumns should be > 1") }
- if ((startcol + ncolumns - 1) > ncol(raster) ) {
- warning("ncolumns too high, truncated")
- ncolumns <- ncol(raster)-startcol }
-
- endrow <- startrow+nrows-1
- if (endrow > nrow(raster)) {
- warning("Rows beyond raster not read")
- endrow <- nrow(raster)
- nrows <- endrow - startrow + 1
- }
- raster <- .rasterRead(raster, startrow, startcol, ncolumns)
- blockdata <- values(raster)
- if (nrows > 1) {
- for (r in (startrow+1):endrow) {
- raster <- .rasterRead(raster, r, startcol, ncolumns)
- blockdata <- c(blockdata, values(raster))
- }
- }
- startcell <- cellFromRowcol(raster, startrow, startcol)
- endcell <- cellFromRowcol(raster, endrow, (startcol+ncolumns-1))
- raster <- setValuesBlock(raster, blockdata, startcell, endcell)
- return(raster)
-}
-
-
-#read part of a single row
-.rasterRead <- function(raster, rownr, startcol=1, ncolumns=(ncol(raster)-startcol+1)) {
- rownr <- round(rownr)
- if (rownr == 0) { stop("rownr == 0. It should be between 1 and nrow(raster), or -1 for all rows") }
- if (rownr > nrow(raster)) { stop("rownr too high") }
- if (startcol < 1) { stop("startcol < 1") }
- if (startcol > ncol(raster)) { stop("startcol > ncol(raster)") }
- if (ncolumns < 1) { stop("ncols should be > 1") }
-
- endcol <- startcol + ncolumns - 1
- if (endcol > ncol(raster)) {
- endcol <- ncol(raster)
- ncolumns <- ncol(raster) - startcol + 1
- }
-
- if (.driver(raster) == 'raster') {
- rastergri <- .setFileExtensionValues(filename(raster))
- if (!file.exists( filename(raster))) {
- stop(paste(filename(raster)," does not exist"))
- }
- con <- file(rastergri, "rb")
- if (raster at file@datatype == "integer") {
- dtype <- integer()
- } else {
- dtype <- numeric()
- }
- if (rownr > 0) {
- seek(con, ((rownr-1) * ncol(raster) + (startcol-1)) * raster at file@datasize)
- result <- readBin(con, what=dtype, n = ncolumns, size = raster at file@datasize, endian = raster at file@byteorder) }
- else {
- result <- readBin(con, what=dtype, n = ncells(raster), size = raster at file@datasize, endian = raster at file@byteorder)
- }
- close(con)
- result[is.nan(result)] <- NA
- result[result <= (0.999 * .nodatavalue(raster)) ] <- NA
- }
- else { #use GDAL
- if (is.na(raster at file@band)) { result <- NA }
- else {
- if (rownr > nrow(raster)) {
- stop("rownr too high")
- }
- if (rownr <= 0) {
- offs <- c(0, 0)
- reg <- c(nrow(raster), ncol(raster)) # reg <- dim(raster at file@gdalhandle[[1]])
- }
- else {
- offs= c((rownr-1), (startcol-1))
- reg <- c(1, ncolumns)
- }
- }
- result <- getRasterData(raster at file@gdalhandle[[1]], offset=offs, region.dim=reg, band = raster at file@band)
- if (!is.vector(result)) { result <- as.vector(result) }
- }
- raster at data@values <- as.vector(result)
- if (rownr < 0) {
- raster at data@indices <- c(1, ncells(raster))
- raster at data@content <- "all"
- raster <- setMinmax(raster)
- } else if (startcol==1 & ncolumns==(ncol(raster)-startcol+1)) {
- raster at data@indices <- c(cellFromRowcol(raster, rownr, startcol), cellFromRowcol(raster, rownr, endcol))
- raster at data@content <- "row"
- } else {
- raster at data@indices <- c(cellFromRowcol(raster, rownr, startcol), cellFromRowcol(raster, rownr, endcol))
- raster at data@content <- "block"
- }
-
- return(raster)
-}
-
-
-#sample while reading and return matrix (for plotting )
-
-readRandom <- function(raster, n=500, na.rm = TRUE) {
- if (dataContent(raster) == 'all') {
- values <- values(raster)
- if (na.rm) { values <- na.omit(values) }
- if (length(values) > n) {
- r <- order(runif(length(values)))
- values <- values[r]
- values <- values[1:n]
- }
- } else {
- if (dataSource(raster) == 'disk') {
- if (ncells(raster) <= n) {
- raster <- readAll(raster)
- values <- cbind(1:ncells(raster), values(raster))
- if (na.rm) { values <- na.omit(values) }
- } else {
- if (na.rm) {
- N <- n
- } else {
- N <- 2 * n
- }
- cells <- unique(as.integer(round(runif(N) * ncells(raster) + 0.5)))
- cells <- cells[cells > 0]
- values <- cellValues(raster, cells)
- if (na.rm) {
- values <- na.omit(values)
- if (length(values) >= n) {
- values <- values[1:n]
- }
- }
- }
- }
- }
- return(values)
-}
-
-
-
-readSkip <- function(raster, maxdim=500, bndbox=NA, asRaster=FALSE) {
- if (!(is.na(bndbox))) {
- rcut <- crop(raster, bndbox)
- warning('bndbox option has not been implemented yet')
- } else {
- rcut <- setRaster(raster)
- }
- # Need to do something with this now.....
-
- rasdim <- max(ncol(raster), nrow(raster) )
- if (rasdim <= maxdim) {
- if (dataContent(raster) == 'all') {
- outras <- raster
- } else {
- outras <- readAll(raster)
- }
- } else {
- fact <- maxdim / rasdim
- nc <- max(1, trunc(fact * ncol(raster)))
- nr <- max(1, trunc(fact * nrow(raster)))
- colint <- round(ncol(raster) / nc)
- rowint <- round(nrow(raster) / nr)
- nc <- trunc(ncol(raster) / colint)
- nr <- trunc(nrow(raster) / rowint)
- cols <- 1:nc
- cols <- 1 + (cols-1) * colint
- dd <- vector()
- if (dataContent(raster) == 'all') {
- for (i in 1:nr) {
- row <- 1 + (i-1) * rowint
- v <- values(raster, row)
- dd <- c(dd, v[cols])
- }
- } else {
- for (i in 1:nr) {
- row <- 1 + (i-1) * rowint
- raster <- readRow(raster, row)
- dd <- c(dd, values(raster)[cols])
- }
- }
- outras <- setRaster(raster)
- outras <- setRowCol(outras, nr, nc)
- xmx <- xmax(raster) - (ncol(raster) - cols[nc]) * xres(raster)
- ymn <- ymin(raster) + (nrow(raster) - row) * yres(raster)
- bndbox <- changeBbox(raster, xmx=xmx, ymn=ymn)
- outras <- setBbox(outras, bndbox, keepres=F)
- outras <- setValues(outras, dd)
- }
- if (asRaster) {
- return(outras)
- } else {
- return(values(outras))
- }
-}
-
-#.readrandom
-# if (length(na.omit(values(x))) > maxcell) {
-# v <- na.omit(cbind(values(x), values(y)))
-# r <- order(runif(length(v[,1])))
-# v <- v[r,]
-# l <- min(maxcell, length(v))
-# v <- v[1:l,]
-# warning(paste("plot used a sample of ", l, " cells (with data; ", maxcell, " when counting NA cells)", sep=""))
-# x <- v[,1]
-# y <- v[,2]
-
-
-#read data on the raster for xy coordinates
-.rasterReadXY <- function(raster, xy) {
- if (!is.matrix(xy)) { xy <- as.matrix(t(xy)) }
- cells <- cellFromXY(raster, xy)
- return(.rasterReadCells(raster, cells))
-}
-
-
-#read data on the raster for cell numbers
-.rasterReadCells <- function(raster, cells) {
- uniquecells <- na.omit(unique(cells[order(cells)]))
- uniquecells <- uniquecells[(uniquecells > 0) & (uniquecells <= ncells(raster))]
- res <- cbind(cells, NA)
- if (length(uniquecells) > 0) {
- if (dataContent(raster) == 'all') {
- vals <- cbind(uniquecells, values(raster)[uniquecells])
- } else if (dataSource(raster) == 'disk') {
- if (.driver(raster) == 'gdal') {
- vals <- .readCellsGDAL(raster, uniquecells)
- } else {
- vals <- .readCellsRaster(raster, uniquecells)
- }
- } else {
- vals <- vector(length=length(uniquecells))
- vals[] <- NA
- }
- if (length((vals) == 1)) {
- res[res[,1]==vals[1],2] <- vals[2]
- } else {
- for (i in 1:length(vals[,1])) {
- res[res[,1]==vals[i,1],2] <- vals[i,2]
- }
- }
- }
- return(res[,2])
-}
-
-
-.readCellsGDAL <- function(raster, cells) {
- colrow <- matrix(ncol=5, nrow=length(cells))
-# valuename <- raster at file@shortname
-# if (valuename == "") {valuename <- "value" }
-# colnames(colrow) <- c("id", "colnr", "rownr", "cell", valuename)
- for (i in 1:length(cells)) {
- colrow[i,1] <- colFromCell(raster, cells[i])
- colrow[i,2] <- rowFromCell(raster, cells[i])
- colrow[i,3] <- cells[i]
- colrow[i,4] <- NA
- }
- rows <- na.omit(unique(colrow[order(colrow[,2]), 2]))
- for (i in 1:length(rows)) {
- raster <- .rasterRead(raster, rows[i])
- thisrow <- subset(colrow, colrow[,2] == rows[i])
- for (j in 1:length(thisrow[,1])) {
- colrow[colrow[,3]==thisrow[j,3],4] <- raster at data@values[thisrow[j,1]]
- }
- }
- return(colrow[,3:4])
-}
-
-
-
-.readCellsRaster <- function(raster, cells) {
-# cells <- cbind(cells, NA)
-# valuename <- raster at file@shortname
-# if (valuename == "") {valuename <- "value" }
-# colnames(cells) <- c("id", "cell", valuename)
-# uniquecells <- na.omit(unique(cells[order(cells[,2]),2]))
-
- rastergri <- .setFileExtensionValues(filename(raster))
- if (!file.exists(filename(raster))) { stop(paste(filename(raster)," does not exist")) }
- con <- file(rastergri, "rb")
-
- res <- vector(length=length(cells))
- res[] <- NA
- for (i in 1:length(cells)) {
- seek(con, (cells[i]-1) * raster at file@datasize)
- if (raster at file@datatype == "integer") { dtype <- integer() } else { dtype <- numeric() }
- res[i] <- readBin(con, what=dtype, n=1, size=raster at file@datasize, endian=raster at file@byteorder)
- }
- close(con)
- res[res <= max(-3e+38, .nodatavalue(raster))] <- NA
- return(cbind(cells,res))
-}
-
-
Modified: pkg/raster/R/raster.write.R
===================================================================
--- pkg/raster/R/raster.write.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/raster.write.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -42,7 +42,7 @@
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)
+ raster <- setMinMax(raster)
if ( raster at file@datatype =='integer') {
if (xmin(raster) > -32767 & xmax(raster) < 32768) {
@@ -148,7 +148,7 @@
if (class(values(raster))=='integer') {
raster <- setDatatype(raster, 'integer')
}
- raster <- setMinmax(raster)
+ raster <- setMinMax(raster)
binraster <- .setFileExtensionValues(filename(raster))
con <- file(binraster, "wb")
Added: pkg/raster/R/read.generic.R
===================================================================
--- pkg/raster/R/read.generic.R (rev 0)
+++ pkg/raster/R/read.generic.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -0,0 +1,153 @@
+# R function for the raster package
+# Author: Robert J. Hijmans
+# International Rice Research Institute. Philippines
+# contact: r.hijmans at gmail.com
+# Date : November 2008
+# Version 0.8
+# Licence GPL v3
+
+
+### readAll ###
+
+if (!isGeneric("readAll")) {
+ setGeneric("readAll", function(object)
+ standardGeneric("readAll"))
+}
+setMethod('readAll', signature(object='RasterLayer'),
+ function(object){ return(.rasterRead(object, -1))}
+)
+setMethod('readAll', signature(object='RasterStack'),
+ function(object){ return(.stackRead(object, -1))}
+)
+
+
+### readRow ###
+
+if (!isGeneric("readRow")) {
+ setGeneric("readRow", function(object, rownr)
+ standardGeneric("readRow"))
+}
+setMethod('readRow', signature(object='RasterLayer'),
+ function(object, rownr){ return(.rasterRead(object, rownr))}
+)
+setMethod('readRow', signature(object='RasterStack'),
+ function(object, rownr){ return(.stackRead(object, rownr))}
+)
+
+
+### readRows ###
+
+if (!isGeneric("readRows")) {
+ setGeneric("readRows", function(object, startrow, nrows=3)
+ standardGeneric("readRows"))
+}
+
+setMethod('readRows', signature(object='RasterLayer'),
+ function(object, startrow, nrows=3) {
+ #read multiple rows
+ return(.rasterReadBlock(object, startrow, nrows))
+ }
+)
+
+
+### readBlock ###
+
+if (!isGeneric("readBlock")) {
+ setGeneric("readBlock", function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1))
+ standardGeneric("readBlock"))
+}
+
+setMethod('readBlock', signature(object='RasterLayer'),
+ function(object, startrow, nrows=3, startcol=1, ncolumns=(ncol(object)-startcol+1)) {
+ return(.rasterReadBlock(object, startrow, nrows, ncolumns))}
+)
+
+
+### readPartOfRow ###
+
+if (!isGeneric("readPartOfRow")) {
+ setGeneric("readPartOfRow", function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1))
+ standardGeneric("readPartOfRow"))
+}
+
+setMethod('readPartOfRow', signature(object='RasterLayer'),
+ function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) {
+ return(.rasterRead(object, rownr, startcol, ncolumns))}
+)
+
+setMethod('readPartOfRow', signature(object='RasterStack'),
+ function(object, rownr, startcol=1, ncolumns=(ncol(object)-startcol+1)) {
+ return( .stackRead(object, rownr, startcol, ncolumns) ) }
+)
+
+
+### cellValues ###
+
+if (!isGeneric("cellValues")) {
+ setGeneric("cellValues", function(object, cells)
+ standardGeneric("cellValues"))
+}
+
+setMethod("cellValues", signature(object='RasterLayer', cells='vector'),
+ function(object, cells) {
+ return(.rasterReadCells(object, cells))
+ }
+)
+
+
+setMethod("cellValues", signature(object='RasterStack', cells='vector'),
+ function(object, cells) {
+ return(.stackReadCells(object, cells))
+ }
+)
+
+
+### xyValues ###
+
+if (!isGeneric("xyValues")) {
+ setGeneric("xyValues", function(object, xyCoords)
+ standardGeneric("xyValues"))
+}
+
+setMethod("xyValues", signature(object='RasterLayer', xyCoords='matrix'),
+ function(object, xyCoords) {
+ if (dim(xyCoords)[2] != 2) {
+ stop('xyCoords has wrong dimensions; there should be 2 columns only' )
+ }
+ cells <- cellFromXY(object, xyCoords)
+ return(.rasterReadCells(object, cells))
+ }
+)
+
+
+setMethod("xyValues", signature(object='RasterStack', xyCoords='matrix'),
+ function(object, xyCoords) {
+ if (dim(xyCoords)[2] != 2) {
+ stop('xyCoords has wrong dimensions; there should be 2 columns only' )
+ }
+ cells <- cellFromXY(object, xyCoords)
+ return(.stackReadCells(object, cells))
+ }
+)
+
+
+
+setMethod("xyValues", signature(object='RasterStack', xyCoords='SpatialPoints'),
+ function(object, xyCoords) {
+ xyCoords <- coordinates(xyCoords)
+ cells <- cellFromXY(object, xyCoords)
+ return(.stackReadCells(object, cells))
+ }
+)
+
+
+setMethod("xyValues", signature(object='RasterStack', xyCoords='SpatialPoints'),
+ function(object, xyCoords) {
+ xyCoords <- coordinates(xyCoords)
+ cells <- cellFromXY(object, xyCoords)
+ return(.stackReadCells(object, cells))
+ }
+)
+
+
+
Added: pkg/raster/R/read.raster.R
===================================================================
--- pkg/raster/R/read.raster.R (rev 0)
+++ pkg/raster/R/read.raster.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -0,0 +1,335 @@
+# R code for reading raster (grid) data
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,4
+# Licence GPL v3
+
+
+#read a block of data (a rectangular area of any dimension)
+.rasterReadBlock <- function(raster, startrow, nrows=3, startcol=1, ncolumns=(ncol(raster)-startcol+1)) {
+ if (startrow < 1 ) { stop("startrow too small") }
+ if (startrow > nrow(raster) ) { stop("startrow too high") }
+ if (nrows < 1) { stop("nrows should be > 1") }
+ if (startcol < 1) { stop("startcol < 1") }
+ if (startcol > ncol(raster)) { stop("startcol > ncol(raster)") }
+ if (ncolumns < 1) { stop("ncolumns should be > 1") }
+ if ((startcol + ncolumns - 1) > ncol(raster) ) {
+ warning("ncolumns too high, truncated")
+ ncolumns <- ncol(raster)-startcol }
+
+ endrow <- startrow+nrows-1
+ if (endrow > nrow(raster)) {
+ warning("Rows beyond raster not read")
+ endrow <- nrow(raster)
+ nrows <- endrow - startrow + 1
+ }
+ raster <- .rasterRead(raster, startrow, startcol, ncolumns)
+ blockdata <- values(raster)
+ if (nrows > 1) {
+ for (r in (startrow+1):endrow) {
+ raster <- .rasterRead(raster, r, startcol, ncolumns)
+ blockdata <- c(blockdata, values(raster))
+ }
+ }
+ startcell <- cellFromRowcol(raster, startrow, startcol)
+ endcell <- cellFromRowcol(raster, endrow, (startcol+ncolumns-1))
+ raster <- setValuesBlock(raster, blockdata, startcell, endcell)
+ return(raster)
+}
+
+
+#read part of a single row
+.rasterRead <- function(raster, rownr, startcol=1, ncolumns=(ncol(raster)-startcol+1)) {
+ rownr <- round(rownr)
+ if (rownr == 0) { stop("rownr == 0. It should be between 1 and nrow(raster), or -1 for all rows") }
+ if (rownr > nrow(raster)) { stop("rownr too high") }
+ if (startcol < 1) { stop("startcol < 1") }
+ if (startcol > ncol(raster)) { stop("startcol > ncol(raster)") }
+ if (ncolumns < 1) { stop("ncols should be > 1") }
+
+ endcol <- startcol + ncolumns - 1
+ if (endcol > ncol(raster)) {
+ endcol <- ncol(raster)
+ ncolumns <- ncol(raster) - startcol + 1
+ }
+
+ if (.driver(raster) == 'raster') {
+ rastergri <- .setFileExtensionValues(filename(raster))
+ if (!file.exists( filename(raster))) {
+ stop(paste(filename(raster)," does not exist"))
+ }
+ con <- file(rastergri, "rb")
+ if (raster at file@datatype == "integer") {
+ dtype <- integer()
+ } else {
+ dtype <- numeric()
+ }
+ if (rownr > 0) {
+ seek(con, ((rownr-1) * ncol(raster) + (startcol-1)) * raster at file@datasize)
+ result <- readBin(con, what=dtype, n = ncolumns, size = raster at file@datasize, endian = raster at file@byteorder) }
+ else {
+ result <- readBin(con, what=dtype, n = ncells(raster), size = raster at file@datasize, endian = raster at file@byteorder)
+ }
+ close(con)
+ result[is.nan(result)] <- NA
+ result[result <= (0.999 * .nodatavalue(raster)) ] <- NA
+ }
+ else { #use GDAL
+ if (is.na(raster at file@band)) { result <- NA }
+ else {
+ if (rownr > nrow(raster)) {
+ stop("rownr too high")
+ }
+ if (rownr <= 0) {
+ offs <- c(0, 0)
+ reg <- c(nrow(raster), ncol(raster)) # reg <- dim(raster at file@gdalhandle[[1]])
+ }
+ else {
+ offs= c((rownr-1), (startcol-1))
+ reg <- c(1, ncolumns)
+ }
+ }
+ result <- getRasterData(raster at file@gdalhandle[[1]], offset=offs, region.dim=reg, band = raster at file@band)
+ if (!is.vector(result)) { result <- as.vector(result) }
+ }
+ raster at data@values <- as.vector(result)
+ if (rownr < 0) {
+ raster at data@indices <- c(1, ncells(raster))
+ raster at data@content <- "all"
+ raster <- setMinMax(raster)
+ } else if (startcol==1 & ncolumns==(ncol(raster)-startcol+1)) {
+ raster at data@indices <- c(cellFromRowcol(raster, rownr, startcol), cellFromRowcol(raster, rownr, endcol))
+ raster at data@content <- "row"
+ } else {
+ raster at data@indices <- c(cellFromRowcol(raster, rownr, startcol), cellFromRowcol(raster, rownr, endcol))
+ raster at data@content <- "block"
+ }
+
+ return(raster)
+}
+
+
+#sample while reading and return matrix (for plotting )
+
+readRandom <- function(raster, n=500, na.rm = TRUE) {
+ if (dataContent(raster) == 'all') {
+ values <- values(raster)
+ if (na.rm) { values <- na.omit(values) }
+ if (length(values) > n) {
+ r <- order(runif(length(values)))
+ values <- values[r]
+ values <- values[1:n]
+ }
+ } else {
+ if (dataSource(raster) == 'disk') {
+ if (ncells(raster) <= n) {
+ raster <- readAll(raster)
+ values <- cbind(1:ncells(raster), values(raster))
+ if (na.rm) { values <- na.omit(values) }
+ } else {
+ if (na.rm) {
+ N <- n
+ } else {
+ N <- 2 * n
+ }
+ cells <- unique(as.integer(round(runif(N) * ncells(raster) + 0.5)))
+ cells <- cells[cells > 0]
+ values <- cellValues(raster, cells)
+ if (na.rm) {
+ values <- na.omit(values)
+ if (length(values) >= n) {
+ values <- values[1:n]
+ }
+ }
+ }
+ }
+ }
+ return(values)
+}
+
+
+
+readSkip <- function(raster, maxdim=500, bndbox=NA, asRaster=FALSE) {
+ if (!(is.na(bndbox))) {
+ rcut <- crop(raster, bndbox)
+ warning('bndbox option has not been implemented yet')
+ } else {
+ rcut <- setRaster(raster)
+ }
+ # Need to do something with this now.....
+
+ rasdim <- max(ncol(raster), nrow(raster) )
+ if (rasdim <= maxdim) {
+ if (dataContent(raster) == 'all') {
+ outras <- raster
+ } else {
+ outras <- readAll(raster)
+ }
+ } else {
+ fact <- maxdim / rasdim
+ nc <- max(1, trunc(fact * ncol(raster)))
+ nr <- max(1, trunc(fact * nrow(raster)))
+ colint <- round(ncol(raster) / nc)
+ rowint <- round(nrow(raster) / nr)
+ nc <- trunc(ncol(raster) / colint)
+ nr <- trunc(nrow(raster) / rowint)
+ cols <- 1:nc
+ cols <- 1 + (cols-1) * colint
+ dd <- vector()
+ if (dataContent(raster) == 'all') {
+ for (i in 1:nr) {
+ row <- 1 + (i-1) * rowint
+ v <- values(raster, row)
+ dd <- c(dd, v[cols])
+ }
+ } else {
+ for (i in 1:nr) {
+ row <- 1 + (i-1) * rowint
+ raster <- readRow(raster, row)
+ dd <- c(dd, values(raster)[cols])
+ }
+ }
+ outras <- setRaster(raster)
+ outras <- setRowCol(outras, nr, nc)
+ xmx <- xmax(raster) - (ncol(raster) - cols[nc]) * xres(raster)
+ ymn <- ymin(raster) + (nrow(raster) - row) * yres(raster)
+ bndbox <- changeBbox(raster, xmx=xmx, ymn=ymn)
+ outras <- setBbox(outras, bndbox, keepres=F)
+ outras <- setValues(outras, dd)
+ }
+ if (asRaster) {
+ return(outras)
+ } else {
+ return(values(outras))
+ }
+}
+
+#.readrandom
+# if (length(na.omit(values(x))) > maxcell) {
+# v <- na.omit(cbind(values(x), values(y)))
+# r <- order(runif(length(v[,1])))
+# v <- v[r,]
+# l <- min(maxcell, length(v))
+# v <- v[1:l,]
+# warning(paste("plot used a sample of ", l, " cells (with data; ", maxcell, " when counting NA cells)", sep=""))
+# x <- v[,1]
+# y <- v[,2]
+
+
+
+
+#read data on the raster for cell numbers
+.rasterReadCells <- function(raster, cells) {
+ uniquecells <- na.omit(unique(cells[order(cells)]))
+ uniquecells <- uniquecells[(uniquecells > 0) & (uniquecells <= ncells(raster))]
+ res <- cbind(cells, NA)
+ if (length(uniquecells) > 0) {
+ if (dataContent(raster) == 'all') {
+ vals <- cbind(uniquecells, values(raster)[uniquecells])
+ } else if (dataSource(raster) == 'disk') {
+ if (.driver(raster) == 'gdal') {
+ vals <- .readCellsGDAL(raster, uniquecells)
+ } else {
+ vals <- .readCellsRaster(raster, uniquecells)
+ }
+ } else {
+ vals <- vector(length=length(uniquecells))
+ vals[] <- NA
+ }
+ if (length(vals) == 1) {
+ res[res[,1]==vals[1],2] <- vals[2]
+ } else {
+ for (i in 1:length(vals[,1])) {
+ res[res[,1]==vals[i,1],2] <- vals[i,2]
+ }
+ }
+ }
+ return(res[,2])
+}
+
+
+.readCellsGDAL <- function(raster, cells) {
+ colrow <- matrix(ncol=5, nrow=length(cells))
+# valuename <- raster at file@shortname
+# if (valuename == "") {valuename <- "value" }
+# colnames(colrow) <- c("id", "colnr", "rownr", "cell", valuename)
+ for (i in 1:length(cells)) {
+ colrow[i,1] <- colFromCell(raster, cells[i])
+ colrow[i,2] <- rowFromCell(raster, cells[i])
+ colrow[i,3] <- cells[i]
+ colrow[i,4] <- NA
+ }
+ rows <- na.omit(unique(colrow[order(colrow[,2]), 2]))
+ for (i in 1:length(rows)) {
+ raster <- .rasterRead(raster, rows[i])
+ thisrow <- subset(colrow, colrow[,2] == rows[i])
+ for (j in 1:length(thisrow[,1])) {
+ colrow[colrow[,3]==thisrow[j,3],4] <- raster at data@values[thisrow[j,1]]
+ }
+ }
+ return(colrow[,3:4])
+}
+
+
+
+.readCellsRaster <- function(raster, cells) {
+# cells <- cbind(cells, NA)
+# valuename <- raster at file@shortname
+# if (valuename == "") {valuename <- "value" }
+# colnames(cells) <- c("id", "cell", valuename)
+# uniquecells <- na.omit(unique(cells[order(cells[,2]),2]))
+
+ rastergri <- .setFileExtensionValues(filename(raster))
+ if (!file.exists(filename(raster))) { stop(paste(filename(raster)," does not exist")) }
+ con <- file(rastergri, "rb")
+
+ res <- vector(length=length(cells))
+ res[] <- NA
+ for (i in 1:length(cells)) {
+ seek(con, (cells[i]-1) * raster at file@datasize)
+ if (raster at file@datatype == "integer") { dtype <- integer() } else { dtype <- numeric() }
+ res[i] <- readBin(con, what=dtype, n=1, size=raster at file@datasize, endian=raster at file@byteorder)
+ }
+ close(con)
+ res[res <= max(-3e+38, .nodatavalue(raster))] <- NA
+ return(cbind(cells,res))
+}
+
+
+.stackRead <- function(rstack, rownumber, startcol=1, ncolumns=(ncol(rstack)-startcol+1)) {
+ for (i in seq(nlayers(rstack))) {
+ raster <- readPartOfRow(rstack at rasters[[i]], rownumber, startcol, ncolumns)
+ if ( i == 1 ) {
+ rstack at data@values <- as.matrix(values(raster))
+ rstack at data@content <- dataContent(raster)
+ rstack at data@indices <- dataIndices(raster)
+ }
+ else {
+ rstack at data@values <- cbind(rstack at data@values, values(raster))
+ }
+ }
+ return(rstack)
+}
+
+.stackReadCells <- function(object, cells) {
+ for (i in seq(nlayers(object))) {
+ v <- .rasterReadCells(object at rasters[[i]], cells)
+ if (i == 1) {
+ result <- v
+ } else {
+ result <- cbind(result, v)
+ # colnames(result)[length(result[1,])] <- rstack at rasters[[i]]@file at shortname
+ }
+ }
+ if (!(is.null(dim(result)))) {
+ for (i in seq(nlayers(object))) {
+ label <- object at rasters[[i]]@file at shortname
+ if (nchar(label) == "") {
+ label <- paste("raster_", i, sep="")
+ }
+ colnames(result)[i] <- label
+ }
+ }
+ return(result)
+}
\ No newline at end of file
Added: pkg/raster/R/read.stack.R
===================================================================
--- pkg/raster/R/read.stack.R (rev 0)
+++ pkg/raster/R/read.stack.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -0,0 +1,6 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0,1
+# Licence GPL v3
+
Modified: pkg/raster/R/set.R
===================================================================
--- pkg/raster/R/set.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/set.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -101,18 +101,33 @@
-setMinmax <- function(raster) {
- if (dataContent(raster) == 'nodata') {
- stop('no data in memory')
- }
- vals <- na.omit(values(raster)) # min and max values
- if (length(vals) > 0) {
- raster at data@min <- min(vals)
- raster at data@max <- max(vals)
+setMinMax <- function(raster, readfromdisk=FALSE) {
+ if (dataContent(raster) != 'all' & dataContent(raster) != 'sparse') {
+ if (readfromdisk) {
+ raster at data@min <- 3e34
+ raster at data@max <- -3e34
+ for (r in 1:nrow(raster)) {
+ raster <- readRow(raster, r)
+ rsd <- na.omit(values(raster)) # min and max values
+ if (length(rsd) > 0) {
+ raster at data@min <- min(minValue(raster), min(rsd))
+ raster at data@max <- max(maxValue(raster), max(rsd))
+ }
+ }
+ raster <- clearValues(raster)
+ } else {
+ stop('no data in memory, and readfromdisk=FALSE')
+ }
} else {
- raster at data@min <- NA
- raster at data@max <- NA
- }
+ vals <- na.omit(values(raster)) # min and max values
+ if (length(vals) > 0) {
+ raster at data@min <- min(vals)
+ raster at data@max <- max(vals)
+ } else {
+ raster at data@min <- NA
+ raster at data@max <- NA
+ }
+ }
raster at data@haveminmax <- TRUE
return(raster)
}
Modified: pkg/raster/R/set.values.R
===================================================================
--- pkg/raster/R/set.values.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/set.values.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -19,7 +19,7 @@
raster at data@content <- 'all'
raster at data@source <- 'ram'
raster at data@indices <- c(1, ncells(raster))
- raster <- setMinmax(raster)
+ raster <- setMinMax(raster)
return(raster)
} else if (length(values) == ncol(raster)) {
if (rownr < 1 | rownr > nrow(raster)) {
@@ -75,7 +75,7 @@
raster at data@values <- sparsevalues
raster at data@indices <- cellnumbers
raster at data@source <- 'ram'
- raster <- setMinmax(raster)
+ raster <- setMinMax(raster)
return(raster)
}
Deleted: pkg/raster/R/stack.read.R
===================================================================
--- pkg/raster/R/stack.read.R 2009-01-13 02:15:56 UTC (rev 125)
+++ pkg/raster/R/stack.read.R 2009-01-13 03:57:43 UTC (rev 126)
@@ -1,52 +0,0 @@
-# Author: Robert J. Hijmans, r.hijmans at gmail.com
-# International Rice Research Institute
-# Date : June 2008
-# Version 0,1
-# Licence GPL v3
-
-
-.stackRead <- function(rstack, rownumber, startcol=1, ncolumns=(ncol(rstack)-startcol+1)) {
- for (i in seq(nlayers(rstack))) {
- raster <- readPartOfRow(rstack at rasters[[i]], rownumber, startcol, ncolumns)
- if ( i == 1 ) {
- rstack at data@values <- as.matrix(values(raster))
- rstack at data@content <- dataContent(raster)
- rstack at data@indices <- dataIndices(raster)
- }
- else {
- rstack at data@values <- cbind(rstack at data@values, values(raster))
- }
- }
- return(rstack)
-}
-
-
-.stackReadXY <- function(rasterstack, xy) {
- cells <- cellFromXY(rasterstack, xy)
- return(.stackReadCells(rasterstack, cells))
-}
-
-
-.stackReadCells <- function(rasterstack, cells) {
- for (i in seq(nlayers(rasterstack))) {
- v <- .rasterReadCells (rasterstack at rasters[[i]], cells)
- if (i == 1) {
- result <- v
- } else {
- result <- cbind(result, v)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/raster -r 126
More information about the Raster-commits
mailing list