From noreply at r-forge.r-project.org  Thu May 23 10:20:34 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 23 May 2013 10:20:34 +0200 (CEST)
Subject: [Rodbcext-commits] r38 - in pkg/geoclimate: . R
Message-ID: <20130523082034.20CDB1850AA@r-forge.r-project.org>

Author: jaunario
Date: 2013-05-23 10:20:33 +0200 (Thu, 23 May 2013)
New Revision: 38

Modified:
   pkg/geoclimate/DESCRIPTION
   pkg/geoclimate/R/fetch.R
   pkg/geoclimate/R/nasa.r
Log:
geoclimate.fetch allows multi-table retrieval of weather data based on xy coordinates.
get.nasa default variables now includes all available data variables on the NASA-POWER website.

Modified: pkg/geoclimate/DESCRIPTION
===================================================================
--- pkg/geoclimate/DESCRIPTION	2013-04-16 01:15:42 UTC (rev 37)
+++ pkg/geoclimate/DESCRIPTION	2013-05-23 08:20:33 UTC (rev 38)
@@ -1,7 +1,7 @@
 Package: geoclimate
 Type: Package
 Title: Climate and Weather Data Processing at the IRRI GIS Laboratory
-Version: 0.0.14
+Version: 0.0.16
 Date: 2009-2-24
 Depends: methods, genutils, weather, RODBC
 Suggests: RCurl, ncdf

Modified: pkg/geoclimate/R/fetch.R
===================================================================
--- pkg/geoclimate/R/fetch.R	2013-04-16 01:15:42 UTC (rev 37)
+++ pkg/geoclimate/R/fetch.R	2013-05-23 08:20:33 UTC (rev 38)
@@ -3,7 +3,7 @@
 # Version 0.0.1
 # Licence GPL v3
 
-.fetch <- function(cells, con, wset, stdate=as.Date("2012-1-1"), endate=as.Date("2012-12-31"), vars=NULL, ...){
+.fetch <- function(cells, con, wset, stdate=as.Date("1983-1-1"), endate=Sys.Date(), vars=NULL, ...){
 	#function(cells, con, wset, stdate=Sys.Date()-as.numeric(format(Sys.Date(),"%j"))+1, endate=Sys.Date(), vars=NULL, ...){
 		
 	# Preventive measures for known MySQL-born issues (i.e cannot open table, disconnected RODBC object) 
@@ -18,17 +18,17 @@
 	# parameter vars general checks and query component construction 
 	if (length(vars)>1){
 		invalids <- which(is.na(vars))
-		if (length(invalids)>0) stop ("Invalid vars specification detected.") else vars <- c("cell", "wdate", vars)		
+		if (length(invalids)>0) stop ("Invalid vars specification detected.") else vars <- c("cell", "wdate AS date", vars)		
 	} else if (length(vars)==0){
 		vars <- "*"
 	} else if ((length(vars)==1 & (is.na(vars) | tolower(vars)=="all" | vars=="*"))){
 		vars <- "*"
 	} else {
-		vars <- c("cell", "wdate", vars)
+		vars <- c("cell", "wdate AS date", vars)
 	}
 	
 	vars <- paste(vars, collapse=", ")
-	query <- paste("SELECT", vars, "FROM", wset, "WHERE (wdate BETWEEN", shQuote(stdate), "AND", shQuote(endate),") AND (cell IN (",paste(cells, collapse=", ") ,")) ORDER BY cell, wdate")
+	query <- paste("SELECT", vars, "FROM", wset, "WHERE (wdate BETWEEN", shQuote(stdate), "AND", shQuote(endate),") AND (cell IN (",paste(cells, collapse=", ") ,")) ORDER BY cell, date")
 	
 	data <- sqlQuery(con, query, ...)
 	
@@ -68,21 +68,23 @@
 					tmp <- .fetch(cells=stdcells, con=connection, wset=paste(srcm$schema_name,srcm$table_name, sep=".") , vars=srcvars[[i]], ...)
 					#tmp <- fetch(cells=cells, con=connection, wset=paste(srcm$schema_name,srcm$table_name, sep=".") , vars=srcvars[[i]]) 
 					tmp$idx <- match(tmp$cell, stdcells) 
-					tmp <- tmp[,-1]
 					tmp[,srcvars[[i]]] <- tmp[,srcvars[[i]]]/srcm$zval
+					tmp <- tmp[,-grep("cell", colnames(tmp))]
 					
 				} else {
 					warning("Non-grid type dataset not yet supported. Skipping.")
 					# TODO support point type 
 					next
 				}
-				if (!exists("outdat")) outdat <- tmp else outdat <- merge(outdat, tmp, by=c("idx","wdate"), all=TRUE)
+				if (!exists("outdat")) outdat <- tmp else outdat <- merge(outdat, tmp, by=c("idx","date"), all=TRUE)
 			}
 			
 			
 			basegrid <- raster() 
 			res(basegrid) <- maxres			
-			cells <- cellFromXY(basegrid,xy)			
+			cells <- cellFromXY(basegrid,xy)	
+			
+			#Generate Psudo-station ID based on maximumresolution. If resolution <.1 multiply by 3600 (seconds in 1 degree) else multiply by 60 (mins in 1 degree)
 			stn <- ifelse(length(gregexpr("0",unlist(strsplit(as.character(maxres),"\\."))[2])[[1]])>1,maxres*3600,maxres*60) 
 			station <- paste(stn, sprintf(paste("%0",nchar(ncell(basegrid)),"d",sep=""),cells),sep="")
 
@@ -102,7 +104,7 @@
 				wth at lon <- xy[i,1]
 				wth at lat <- xy[i,2]
 				wth at alt <- -99
-				wth at w <- outdat[outdat$idx==i,-1]					 
+				wth at w <- outdat[outdat$idx==i,-(grep("idx", colnames(outdat)))]					 
 				outlist[[i]] <- wth
 			}
 			return(outlist)				

Modified: pkg/geoclimate/R/nasa.r
===================================================================
--- pkg/geoclimate/R/nasa.r	2013-04-16 01:15:42 UTC (rev 37)
+++ pkg/geoclimate/R/nasa.r	2013-05-23 08:20:33 UTC (rev 38)
@@ -3,7 +3,7 @@
 # Version 0.0.1
 # Licence GPL v3
 
-get.nasa <- function(x, y, stdate="1983-1-1", endate=Sys.Date(), savepath=getwd(), rm.existing=FALSE){
+get.nasa <- function(x, y, vars=c("toa_dwn","swv_dwn","lwv_dwn","T2M", "T2MN","T2MX", "RH2M", "DFP2M","RAIN", "WS10M"),stdate="1983-1-1", endate=Sys.Date(), savepath=getwd(), rm.existing=FALSE){
 	result <- new("weather")
 	src <- ""
 	if(length(x)!=1|length(y)!=1){
@@ -26,7 +26,8 @@
 	endate <- as.Date(endate)
 	
 	fname <- paste(paste("nasa",cell,x,y,format(stdate,"%Y.%m.%d"),format(endate,"%Y.%m.%d"), sep="_"), ".txt",sep="")
-	dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=swv_dwn&p=T2M&p=T2MN&p=T2MX&p=RH2M&p=DFP2M&p=RAIN&p=WS10M&submit=Submit", sep="")
+	#dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=swv_dwn&p=T2M&p=T2MN&p=T2MX&p=RH2M&p=DFP2M&p=RAIN&p=WS10M&submit=Submit", sep="")
+	dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=", paste(vars,collapse="&p",sep=""),"&submit=Submit", sep="")
 	
 	show.message("Reading ", appendLF=FALSE)
 	if (!file.exists(paste(savepath, fname, sep="/"))){


From noreply at r-forge.r-project.org  Thu May 23 10:46:39 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 23 May 2013 10:46:39 +0200 (CEST)
Subject: [Rodbcext-commits] r39 - pkg/geoclimate/R
Message-ID: <20130523084639.89F2A185173@r-forge.r-project.org>

Author: jaunario
Date: 2013-05-23 10:46:39 +0200 (Thu, 23 May 2013)
New Revision: 39

Modified:
   pkg/geoclimate/R/nasa.r
Log:
Corrected url used for downloading nasa-power data in get.nasa function.

Modified: pkg/geoclimate/R/nasa.r
===================================================================
--- pkg/geoclimate/R/nasa.r	2013-05-23 08:20:33 UTC (rev 38)
+++ pkg/geoclimate/R/nasa.r	2013-05-23 08:46:39 UTC (rev 39)
@@ -27,7 +27,7 @@
 	
 	fname <- paste(paste("nasa",cell,x,y,format(stdate,"%Y.%m.%d"),format(endate,"%Y.%m.%d"), sep="_"), ".txt",sep="")
 	#dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=swv_dwn&p=T2M&p=T2MN&p=T2MX&p=RH2M&p=DFP2M&p=RAIN&p=WS10M&submit=Submit", sep="")
-	dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=", paste(vars,collapse="&p",sep=""),"&submit=Submit", sep="")
+	dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=", paste(vars,collapse="&p=",sep=""),"&submit=Submit", sep="")
 	
 	show.message("Reading ", appendLF=FALSE)
 	if (!file.exists(paste(savepath, fname, sep="/"))){


From noreply at r-forge.r-project.org  Tue May 28 10:49:41 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 28 May 2013 10:49:41 +0200 (CEST)
Subject: [Rodbcext-commits] r40 - in pkg/geoclimate: . R
Message-ID: <20130528084941.B23951845C2@r-forge.r-project.org>

Author: jaunario
Date: 2013-05-28 10:49:41 +0200 (Tue, 28 May 2013)
New Revision: 40

Modified:
   pkg/geoclimate/DESCRIPTION
   pkg/geoclimate/R/nasa.r
   pkg/geoclimate/R/upload.r
Log:
Enabled users to choose weather variables on get.nasa. (default=all variables)
Perform column checks on upload.nasa

Modified: pkg/geoclimate/DESCRIPTION
===================================================================
--- pkg/geoclimate/DESCRIPTION	2013-05-23 08:46:39 UTC (rev 39)
+++ pkg/geoclimate/DESCRIPTION	2013-05-28 08:49:41 UTC (rev 40)
@@ -1,7 +1,7 @@
 Package: geoclimate
 Type: Package
 Title: Climate and Weather Data Processing at the IRRI GIS Laboratory
-Version: 0.0.16
+Version: 0.0.17
 Date: 2009-2-24
 Depends: methods, genutils, weather, RODBC
 Suggests: RCurl, ncdf

Modified: pkg/geoclimate/R/nasa.r
===================================================================
--- pkg/geoclimate/R/nasa.r	2013-05-23 08:46:39 UTC (rev 39)
+++ pkg/geoclimate/R/nasa.r	2013-05-28 08:49:41 UTC (rev 40)
@@ -27,7 +27,7 @@
 	
 	fname <- paste(paste("nasa",cell,x,y,format(stdate,"%Y.%m.%d"),format(endate,"%Y.%m.%d"), sep="_"), ".txt",sep="")
 	#dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=swv_dwn&p=T2M&p=T2MN&p=T2MX&p=RH2M&p=DFP2M&p=RAIN&p=WS10M&submit=Submit", sep="")
-	dlurl <- paste("http://earth-www.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=", paste(vars,collapse="&p=",sep=""),"&submit=Submit", sep="")
+	dlurl <- paste("http://power.larc.nasa.gov/cgi-bin/cgiwrap/solar/agro.cgi?email=agroclim%40larc.nasa.gov&step=1&lat=",y,"&lon=",x,"&ms=",format(stdate,"%m"),"&ds=",format(stdate,"%d"),"&ys=",format(stdate,"%Y"),"&me=",format(endate,"%m"),"&de=",format(endate,"%d"),"&ye=",format(endate,"%Y"),"&p=", paste(vars,collapse="&p=",sep=""),"&submit=Submit", sep="")
 	
 	show.message("Reading ", appendLF=FALSE)
 	if (!file.exists(paste(savepath, fname, sep="/"))){
@@ -51,10 +51,10 @@
 		# Check download integrity
 		stline <- grep(paste(format(stdate,"%Y"),format(as.numeric(format(stdate,"%j")),width=3)), dlines)
 		endline <- grep(paste(format(endate,"%Y"),format(as.numeric(format(endate,"%j")),width=3)), dlines)
-		
+		 
 		if (length(stline)!=1|length(endline)!=1){
 			msg <- paste("Incomplete or No data found on file. If file", fname, "is on disk, remove the file then rerun this program.")
-		} else if(length(unlist(strsplit(dlines[endline], "[[:space:]]+")))!=10){
+		} else if(length(unlist(strsplit(dlines[endline], "[[:space:]]+")))!=(length(vars)+2)){
 			msg <- paste("Incomplete download detected. If file", fname, "is on disk, remove the file then rerun this program.")
 		} else {
 			msg <- paste("Read from", src)
@@ -63,11 +63,12 @@
 			dlines <- dlines[stline:endline]
 			dvector <- unlist(strsplit(dlines, "[[:space:]]+"))
 			dvector[dvector=="-"] <- NA
-			nasadata <- as.data.frame(matrix(as.numeric(dvector), ncol=10, byrow=TRUE))
-			colnames(nasadata) <- c("yr", "doy", "srad", "tavg", "tmin", "tmax", "rh2m", "tdew", "prec", "wind")
-			wdate <- format(as.Date(paste(nasadata$yr,nasadata$doy),"%Y %j"),"%Y-%m-%d")
-			nasadata <- cbind(wdate, nasadata[,-(1:2)], stringsAsFactors=FALSE)
+			nasadata <- as.data.frame(matrix(as.numeric(dvector), ncol=(length(vars)+2), byrow=TRUE))
+			colnames(nasadata) <- c("yr", "doy", vars)
 			
+			date <- format(as.Date(paste(nasadata$yr,nasadata$doy),"%Y %j"),"%Y-%m-%d")
+			nasadata <- cbind(date, nasadata[,-(1:2)], stringsAsFactors=FALSE)
+			
 			result at alt <- alt
 			result at w <- nasadata
 			rm(dlines,dvector,nasadata)

Modified: pkg/geoclimate/R/upload.r
===================================================================
--- pkg/geoclimate/R/upload.r	2013-05-23 08:46:39 UTC (rev 39)
+++ pkg/geoclimate/R/upload.r	2013-05-28 08:49:41 UTC (rev 40)
@@ -7,8 +7,7 @@
 SM.append <- 2
 
 .upload <- function(con, wthdframe, tablename, savemode=SM.append,...){
-	
-	proc <- try(sqlSave(con, wthdframe, tablename, rownames=FALSE, append=TRUE,...))
+	proc <- try(sqlSave(con, wthdframe, tablename, rownames=FALSE, append=(savemode==SM.append),...))
 	success <- class(proc)!="try-error"
 	if(!success) show.message(proc, appendLF=TRUE)
 	#TODO: support transaction
@@ -34,17 +33,23 @@
     return(success)    
 }
 
-upload.nasa <- function(dbasecon, nasa, setname='nasa_1d'){
+upload.nasa <- function(dbasecon, nasa, cols=c("wdate","toa_dwn", "srad", "lwv_dwn", "tavg", "tmin", "tmax", "rh2m", "tdew", "prec", "wind"), setname='nasa_1d'){
 	# TODO: support transaction
     success <- FALSE
-
+	
 	if (class(nasa)!="weather"){
 		stop("Invalid nasa input. Should be class 'weather'")
 	} 
 	
-	inasa <- cbind(as.numeric(nasa at stn), nasa at w)
-	colnames(inasa) <- c('cell', colnames(nasa at w))
-	success <- .upload(dbasecon, inasa, tablename=setname)
+	#check colnames
+	cols <- c("cell", cols)
+	fields <- sqlColumns(dbasecon, setname)$COLUMN_NAME
+	if(length(fields)!=length(cols)) stop("Number of variables of data to be uploaded doesn't match target table ", setname)
+	if(sum(fields==cols)!=length(fields)) stop("Column names of data to be uploaded doesn't match target table ", setname)
+	
+	nasa at w <- cbind(as.numeric(nasa at stn), nasa at w)
+	colnames(nasa at w) <- cols
+	success <- .upload(con=dbasecon, wthdframe=nasa at w, tablename=setname)
     return(success)    
 }
 


From noreply at r-forge.r-project.org  Wed May 29 11:10:16 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 29 May 2013 11:10:16 +0200 (CEST)
Subject: [Rodbcext-commits] r41 - in pkg/geoclimate: . R
Message-ID: <20130529091016.A726E18575D@r-forge.r-project.org>

Author: jaunario
Date: 2013-05-29 11:10:16 +0200 (Wed, 29 May 2013)
New Revision: 41

Modified:
   pkg/geoclimate/DESCRIPTION
   pkg/geoclimate/R/fetch.R
   pkg/geoclimate/R/upload.r
Log:
Dependency on weather changed to old weather.
geoclimate.fetch fixed single table result.
upload.nasa now flexible on what columns will be uploaded on the server.

Modified: pkg/geoclimate/DESCRIPTION
===================================================================
--- pkg/geoclimate/DESCRIPTION	2013-05-28 08:49:41 UTC (rev 40)
+++ pkg/geoclimate/DESCRIPTION	2013-05-29 09:10:16 UTC (rev 41)
@@ -1,9 +1,9 @@
 Package: geoclimate
 Type: Package
 Title: Climate and Weather Data Processing at the IRRI GIS Laboratory
-Version: 0.0.17
+Version: 0.0.18
 Date: 2009-2-24
-Depends: methods, genutils, weather, RODBC
+Depends: methods, genutils, oldweather, RODBC
 Suggests: RCurl, ncdf
 Author: Jorrel Khalil S. Aunario
 Maintainer: <jaunario at gmail.com>

Modified: pkg/geoclimate/R/fetch.R
===================================================================
--- pkg/geoclimate/R/fetch.R	2013-05-28 08:49:41 UTC (rev 40)
+++ pkg/geoclimate/R/fetch.R	2013-05-29 09:10:16 UTC (rev 41)
@@ -42,13 +42,13 @@
 
 
 setMethod("geoclimate.fetch", signature(xy="matrix", srcvars="list", connection="RODBC"),
-		function(xy, srcvars, connection, ...){
+		function(xy, srcvars, connection, warehouse="geowarehouse",...){
 			
 			# Connect to database
 			#connection <- odbcConnect(connection)
 			
 			# Get dataset meta data for location matching
-			srcmeta <- sqlQuery(connection,paste("SELECT * FROM geowarehouse.climate_data WHERE table_name in (", paste(shQuote(unique(names(srcvars))),collapse=", "),")"), stringsAsFactors=FALSE)
+			srcmeta <- sqlQuery(connection,paste("SELECT * FROM ", warehouse,".climate_data WHERE table_name in (", paste(shQuote(unique(names(srcvars))),collapse=", "),")", sep=""), stringsAsFactors=FALSE)
 			maxres <- NA
 			for (i in 1:length(srcvars)){
 				srcm <- srcmeta[srcmeta$table_name==names(srcvars)[i],]				
@@ -66,7 +66,7 @@
 					
 					stdcells <- cellFromXY(baseraster,xy)
 					tmp <- .fetch(cells=stdcells, con=connection, wset=paste(srcm$schema_name,srcm$table_name, sep=".") , vars=srcvars[[i]], ...)
-					#tmp <- fetch(cells=cells, con=connection, wset=paste(srcm$schema_name,srcm$table_name, sep=".") , vars=srcvars[[i]]) 
+				    #tmp <- fetch(cells=stdcells, con=connection, wset=paste(srcm$schema_name,srcm$table_name, sep=".") , vars=srcvars[[i]]) 
 					tmp$idx <- match(tmp$cell, stdcells) 
 					tmp[,srcvars[[i]]] <- tmp[,srcvars[[i]]]/srcm$zval
 					tmp <- tmp[,-grep("cell", colnames(tmp))]

Modified: pkg/geoclimate/R/upload.r
===================================================================
--- pkg/geoclimate/R/upload.r	2013-05-28 08:49:41 UTC (rev 40)
+++ pkg/geoclimate/R/upload.r	2013-05-29 09:10:16 UTC (rev 41)
@@ -49,7 +49,7 @@
 	
 	nasa at w <- cbind(as.numeric(nasa at stn), nasa at w)
 	colnames(nasa at w) <- cols
-	success <- .upload(con=dbasecon, wthdframe=nasa at w, tablename=setname)
+	success <- .upload(con=dbasecon, wthdframe=nasa at w[,fields], tablename=setname)
     return(success)    
 }