[Raster-commits] r268 - pkg/raster/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 10 14:49:51 CET 2009
Author: rhijmans
Date: 2009-02-10 14:49:51 +0100 (Tue, 10 Feb 2009)
New Revision: 268
Added:
pkg/raster/R/readRandom.R
pkg/raster/R/readSkip.R
Modified:
pkg/raster/R/read.raster.R
Log:
Modified: pkg/raster/R/read.raster.R
===================================================================
--- pkg/raster/R/read.raster.R 2009-02-10 10:14:39 UTC (rev 267)
+++ pkg/raster/R/read.raster.R 2009-02-10 13:49:51 UTC (rev 268)
@@ -123,117 +123,7 @@
}
-#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 (ncell(raster) <= n) {
- raster <- readAll(raster)
- values <- cbind(1:ncell(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) * ncell(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])
- }
- }
- }
- if (asRaster) {
- 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)
- return(outras)
- } else {
- return(dd)
- }
-}
-
-
-
-#.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)]))
Added: pkg/raster/R/readRandom.R
===================================================================
--- pkg/raster/R/readRandom.R (rev 0)
+++ pkg/raster/R/readRandom.R 2009-02-10 13:49:51 UTC (rev 268)
@@ -0,0 +1,104 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+#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 (ncell(raster) <= n) {
+ raster <- readAll(raster)
+ values <- cbind(1:ncell(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) * ncell(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])
+ }
+ }
+ }
+ if (asRaster) {
+ 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)
+ return(outras)
+ } else {
+ return(dd)
+ }
+}
+
+
Added: pkg/raster/R/readSkip.R
===================================================================
--- pkg/raster/R/readSkip.R (rev 0)
+++ pkg/raster/R/readSkip.R 2009-02-10 13:49:51 UTC (rev 268)
@@ -0,0 +1,62 @@
+# Author: Robert J. Hijmans, r.hijmans at gmail.com
+# International Rice Research Institute
+# Date : June 2008
+# Version 0.8
+# Licence GPL v3
+
+
+
+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 at data@values <- dd
+ }
+ if (asRaster) {
+ return(outras)
+ } else {
+ return(values(outras))
+ }
+}
More information about the Raster-commits
mailing list