[Rodbcext-commits] r36 - pkg/geoclimate/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 15 06:42:35 CET 2013
Author: jaunario
Date: 2013-03-15 06:42:35 +0100 (Fri, 15 Mar 2013)
New Revision: 36
Added:
pkg/geoclimate/R/datasets.R
pkg/geoclimate/R/fetch.R
Modified:
pkg/geoclimate/R/trmm.r
Log:
Added datasets and fetch functions
TRMM pixels changed to match a raster with longitude from -180 to 180 instead of the original 0 to 360
Added: pkg/geoclimate/R/datasets.R
===================================================================
--- pkg/geoclimate/R/datasets.R (rev 0)
+++ pkg/geoclimate/R/datasets.R 2013-03-15 05:42:35 UTC (rev 36)
@@ -0,0 +1,10 @@
+# Author: Jorrel Khalil S. Aunario, jaunario at gmail.com
+# Date : 15 March 2013
+# Version 0.0.1
+# Licence GPL v3
+
+datasets <- function(con){
+ return(sqlQuery(con,"SELECT * FROM datasets"))
+}
+
+
Added: pkg/geoclimate/R/fetch.R
===================================================================
--- pkg/geoclimate/R/fetch.R (rev 0)
+++ pkg/geoclimate/R/fetch.R 2013-03-15 05:42:35 UTC (rev 36)
@@ -0,0 +1,33 @@
+# Author: Jorrel Khalil S. Aunario, jaunario at gmail.com
+# Date : 14 March 2013
+# Version 0.0.1
+# Licence GPL v3
+
+.fetch <- function(cell, con, wset, stdate, endate, vars=NULL, ...){
+ if (is.null(vars)|is.na(vars)) vars <- "*" else vars <- paste(vars, collapse=", ")
+ query <- paste("SELECT", vars, "FROM", wset, "WHERE (wdate BETWEEN", stdate, "AND", endate,") AND (cell IN (",paste(cell, collapse=", ") ,")")
+ data <- sqlQuery(con, query, ...)
+ return(data)
+}
+
+setMethod("geoclimate.fetch", signature(x="integer"),
+ function(x, ...){
+ return (.fetch(cell=x,...))
+ }
+)
+
+setMethod("geoclimate.fetch", signature(x="matrix"),
+ function(x, ...){
+
+ }
+)
+
+setMethod("geoclimate.fetch", signature(x="data.frame"),
+ function(x, ...){
+
+})
+
+setMethod("geoclimate.fetch", signature(x="RasterLayer"),
+ function(x, ...){
+
+})
Modified: pkg/geoclimate/R/trmm.r
===================================================================
--- pkg/geoclimate/R/trmm.r 2013-01-17 05:58:04 UTC (rev 35)
+++ pkg/geoclimate/R/trmm.r 2013-03-15 05:42:35 UTC (rev 36)
@@ -60,21 +60,24 @@
if (class(savepath)=="character" & !file.exists(paste(savepath,fname,sep="/"))) writeBin(rawtrmm, paste(savepath,fname,sep="/"))
wth at rmk <- prod.ftp
+ trmmraster <- raster(extent(0,360,-50,50))
+ baseraster <- raster()
+ res(trmmraster) <- res(baseraster) <- 0.25
+ txy <- as.data.frame(xyFromCell(trmmraster, 1:ncell(trmmraster)))
+ txy$x[txy$x>180] <- txy$x[txy$x>180]-360
+ cell <- cellFromXY(baseraster, txy)
- baseraster <- raster(extent(-180,180,-50,50))
- res(baseraster) <- 0.25
- cell <- 1:ncell(baseraster)
-
- prec <- matrix(readBin(rawtrmm, double(), endian="big", size=4, n=ncell(baseraster)), ncol=ncol(baseraster), nrow=nrow(baseraster), byrow=TRUE)
+ prec <- matrix(readBin(rawtrmm, double(), endian="big", size=4, n=ncell(trmmraster)), ncol=ncol(trmmraster), nrow=nrow(trmmraster), byrow=TRUE)
prec[prec==min(prec)] <- NA
prec <- prec[nrow(prec):1,]
- baseraster[] <- prec
+ trmmraster[] <- prec
wth at w <- as.data.frame(cell)
wth at w$wdate <- as.character(wdate)
- wth at w$prec <- values(baseraster)
- rm(baseraster, prec, cell)
+ wth at w$prec <- values(trmmraster)
+ wth at w <- wth at w[order(cell),]
+ rm(trmmraster, baseraster, prec, cell)
gc(verbose=FALSE)
}
More information about the Rodbcext-commits
mailing list