From noreply at r-forge.r-project.org  Fri Mar 15 06:42:35 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 15 Mar 2013 06:42:35 +0100 (CET)
Subject: [Rodbcext-commits] r36 - pkg/geoclimate/R
Message-ID: <20130315054235.9B521180953@r-forge.r-project.org>

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)		
 	}