[Rodbcext-commits] r20 - in pkg: genutils/R geoclimate geoclimate/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 4 11:13:12 CEST 2012
Author: jaunario
Date: 2012-04-04 11:13:12 +0200 (Wed, 04 Apr 2012)
New Revision: 20
Modified:
pkg/genutils/R/sysutils.r
pkg/geoclimate/DESCRIPTION
pkg/geoclimate/R/gsod.r
pkg/geoclimate/R/nasa.r
Log:
withRetry returns try-error object instead of vector()
added GSOD.update, get.nasa returns empty weather class with error message as remark
Modified: pkg/genutils/R/sysutils.r
===================================================================
--- pkg/genutils/R/sysutils.r 2012-03-30 09:12:03 UTC (rev 19)
+++ pkg/genutils/R/sysutils.r 2012-04-04 09:13:12 UTC (rev 20)
@@ -17,7 +17,6 @@
success <- TRUE
}
}
- if (!success) items <- vector()
return(items)
}
Modified: pkg/geoclimate/DESCRIPTION
===================================================================
--- pkg/geoclimate/DESCRIPTION 2012-03-30 09:12:03 UTC (rev 19)
+++ pkg/geoclimate/DESCRIPTION 2012-04-04 09:13:12 UTC (rev 20)
@@ -1,7 +1,7 @@
Package: geoclimate
Type: Package
Title: Climate and Weather Data Processing at the IRRI GIS Laboratory
-Version: 0.0.3
+Version: 0.0.4
Date: 2009-2-24
Depends: methods, genutils, weather
Suggests: RODBC, ncdf, RCurl
Modified: pkg/geoclimate/R/gsod.r
===================================================================
--- pkg/geoclimate/R/gsod.r 2012-03-30 09:12:03 UTC (rev 19)
+++ pkg/geoclimate/R/gsod.r 2012-04-04 09:13:12 UTC (rev 20)
@@ -8,26 +8,44 @@
GSOD.varrefs <- read.csv(system.file("gsod_ref.csv", package="geoclimate"), stringsAsFactors=FALSE)
# TODO proper parse of GSOD.stations
GSOD.stations <- read.csv(system.file("gsod_stations.csv", package="geoclimate"), stringsAsFactors=FALSE)
+GSOD.stations$stationid <- paste(sprintf("%05d",GSOD.stations$USAF), GSOD.stations$WBAN, sep="-")
-
GSOD.update <- function(){
- if(!file.copy(system.file("gsod_stations.csv", package="geoclimate"),paste(system.file("gsod_stations.csv", package="geoclimate"),".bck",sep=""),overwrite=TRUE)){
- show.message("Unable to create station data backup file. GSOD update process aborted.", appendLF=TRUE)
+ success <- FALSE
+ if(!require(RCurl)){
+ show.message("Error: RCurl package not found.", appendLF=TRUE)
} else {
- show.message("Downloading station info file from GSOD FTP site.", EL=TRUE, appendLF=FALSE)
- dl.success <- withRetry(download.file("ftp://ftp.ncdc.noaa.gov/pub/data/inventories/ISH-HISTORY.CSV",system.file("gsod_stations.csv", package="geoclimate"),mode="wb"))
- if (dl.success!=0){
- show.message("Failed to connect GSOD FTP site.", appendLF=TRUE)
- file.copy(system.file("gsod_stations.csv.bck", package="geoclimate"),system.file("gsod_stations.csv", package="geoclimate"),overwrite=TRUE)
+ show.message("Checking file date.", appendLF=TRUE)
+ online <- unlist(strsplit(getURL("ftp://ftp.ncdc.noaa.gov/pub/data/inventories/"),"\r\n"))
+ oinfo <- unlist(strsplit(online[grep("ISH-HISTORY.CSV",online)],"[[:space:]]+"))[6:7]
+
+ age <- difftime(as.Date(paste(oinfo, collapse=" "), "%b %d"),file.info(system.file("gsod_stations.csv", package="geoclimate"))$ctime, units="weeks")
+ if (age<2){
+ show.message("GSOD station file is upto date.", appendLF=TRUE)
+ success <- TRUE
} else {
- show.message("Reading station info file from GSOD website.", appendLF=TRUE)
- assign("GSOD.stations", read.csv(system.file("gsod_stations.csv", package="geoclimate"), stringsAsFactors=FALSE),envir=.GlobalEnv)
+
+ if(!file.copy(system.file("gsod_stations.csv", package="geoclimate"),paste(system.file("gsod_stations.csv", package="geoclimate"),".bck",sep=""),overwrite=TRUE)){
+ show.message("Unable to create station data backup file. GSOD update process aborted.", appendLF=TRUE)
+ } else {
+ show.message("Downloading station info file from GSOD FTP site.", EL=TRUE, appendLF=FALSE)
+ dl.success <- withRetry(download.file("ftp://ftp.ncdc.noaa.gov/pub/data/inventories/ISH-HISTORY.CSV",system.file("gsod_stations.csv", package="geoclimate"),mode="wb"))
+ if (dl.success!=0){
+ show.message("Failed to connect GSOD FTP site.", appendLF=TRUE)
+ file.copy(system.file("gsod_stations.csv.bck", package="geoclimate"),system.file("gsod_stations.csv", package="geoclimate"),overwrite=TRUE)
+ } else {
+ show.message("Reading station info file from GSOD website.", appendLF=TRUE)
+ assign("GSOD.stations", read.csv(system.file("gsod_stations.csv", package="geoclimate"), stringsAsFactors=FALSE),envir=.GlobalEnv)
+ }
+ show.message("GSOD Stations info update complete.", EL=TRUE, appendLF=TRUE)
+ success <- TRUE
+ }
}
- }
+ }
}
get.gsod <- function(year, station, savepath=getwd(), rm.existing=FALSE){
- result <- vector()
+ result <- new("weather")
if(!force.directories(savepath, recursive=TRUE)){
show.message("Error: Can't create download path.", appendLF=TRUE)
Modified: pkg/geoclimate/R/nasa.r
===================================================================
--- pkg/geoclimate/R/nasa.r 2012-03-30 09:12:03 UTC (rev 19)
+++ pkg/geoclimate/R/nasa.r 2012-04-04 09:13:12 UTC (rev 20)
@@ -3,64 +3,78 @@
# Version 0.0.1
# Licence GPL v3
-#TODO option savefile or not
get.nasa <- function(x, y, stdate="1983-1-1", endate=Sys.Date(), savepath=getwd(), rm.existing=FALSE){
- result <- vector()
+ result <- new("weather")
+ src <- ""
if(length(x)!=1|length(y)!=1){
show.message("Warning: Either x or y has length > 1. Using first only.", appendLF=TRUE)
x <- x[1]
y <- y[1]
}
- if(!force.directories(savepath)) {
- show.message("Error: Cannot create ", savepath, appendLF=TRUE)
+ result at lon <- x
+ result at lat <- y
+
+ # check if downloaded file can be saved to disk
+ savepath[is.na(savepath)] <- NULL
+ proceedwrite <- ifelse(is.character(savepath),force.directories(savepath),FALSE)
+
+ cell <- cellFromXY(raster(),t(c(x,y)))
+ result at stn <- as.character(cell)
+
+
+ stdate <- as.Date(stdate)
+ 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="")
+
+ show.message("Reading ", appendLF=FALSE)
+ if (!file.exists(paste(savepath, fname, sep="/"))){
+ show.message(dlurl, appendLF=TRUE)
+ dlines <- withRetry(readLines(dlurl))
+ src <- dlurl
+ } else if (rm.existing | file.info(paste(savepath, fname, sep="/"))$size==0){
+ file.remove(paste(savepath, fname, sep="/"))
+ show.message(dlurl, appendLF=TRUE)
+ dlines <- withRetry(readLines(dlurl))
+ src <- dlurl
} else {
- stdate <- as.Date(stdate)
- endate <- as.Date(endate)
-
- fname <- paste(savepath, paste(paste("nasa",x,y,format(stdate,"%Y.%m.%d"),format(endate,"%Y.%m.%d"), sep="_"), ".txt",sep=""), 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="")
-
- show.message("Reading ", appendLF=FALSE)
- if (!file.exists(fname)){
- show.message(dlurl, appendLF=TRUE)
- dlines <- withRetry(readLines(dlurl))
- } else if (rm.existing | file.info(fname)$size==0){
- file.remove(fname)
- show.message(dlurl, appendLF=TRUE)
- dlines <- withRetry(readLines(dlurl))
- } else {
- show.message(fname, appendLF=TRUE)
- dlines <- readLines(fname)
- }
-
+ show.message(paste(savepath, fname, sep="/"), appendLF=TRUE)
+ dlines <- readLines(paste(savepath, fname, sep="/"))
+ src <- paste(savepath, fname, sep="/")
+ }
+
+ if (class(dlines)=="try-error"){
+ msg <- as.character(dlines)
+ } else {
# 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){
- show.message("Incomplete or No data found on file. If file ", basename(fname), " is on disk, remove the file then rerun this program.")
-
- } else if(length(unlist(strsplit(gsub("[[:space:]]+"," ",dlines[endline]), " ")))!=10){
- show.message("Incomplete download detected. If file ", basename(fname), " is on disk, remove the file then rerun this program.")
+ 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){
+ msg <- paste("Incomplete download detected. If file", fname, "is on disk, remove the file then rerun this program.")
} else {
- writeLines(dlines, fname)
+ msg <- paste("Read from", src)
+ if (proceedwrite) writeLines(dlines, paste(savepath, fname, sep="/"))
alt <- as.numeric(unlist(strsplit(dlines[grep("Elevation", dlines)],"="))[2])
dlines <- dlines[stline:endline]
- dvector <- unlist(strsplit(gsub("[[:space:]]+"," ",dlines), " "))
+ 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)
- result <- new('weather')
- result at stn <- as.character(cellFromXY(raster(),t(c(x,y))))
- result at lon <- x
- result at lat <- y
+
result at alt <- alt
result at w <- nasadata
rm(dlines,dvector,nasadata)
gc(verbose=FALSE)
}
}
+ show.message(msg)
+ result at rmk <- msg
return(result)
}
\ No newline at end of file
More information about the Rodbcext-commits
mailing list