[Rodbcext-commits] r40 - in pkg/geoclimate: . R

[noreply at 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)    
 }