[Rodbcext-commits] r21 - in pkg/geoclimate: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri May 18 11:48:57 CEST 2012
Author: jaunario
Date: 2012-05-18 11:48:56 +0200 (Fri, 18 May 2012)
New Revision: 21
Added:
pkg/geoclimate/R/fse.r
Modified:
pkg/geoclimate/DESCRIPTION
pkg/geoclimate/R/gsod.r
pkg/geoclimate/R/upload.r
Log:
Added read.FSE (fse.r), upload.FSE
Modified get.gsod and upload.gsod
Added GSOD.updateStations
Modified: pkg/geoclimate/DESCRIPTION
===================================================================
--- pkg/geoclimate/DESCRIPTION 2012-04-04 09:13:12 UTC (rev 20)
+++ pkg/geoclimate/DESCRIPTION 2012-05-18 09:48:56 UTC (rev 21)
@@ -1,7 +1,7 @@
Package: geoclimate
Type: Package
Title: Climate and Weather Data Processing at the IRRI GIS Laboratory
-Version: 0.0.4
+Version: 0.0.7
Date: 2009-2-24
Depends: methods, genutils, weather
Suggests: RODBC, ncdf, RCurl
Added: pkg/geoclimate/R/fse.r
===================================================================
--- pkg/geoclimate/R/fse.r (rev 0)
+++ pkg/geoclimate/R/fse.r 2012-05-18 09:48:56 UTC (rev 21)
@@ -0,0 +1,85 @@
+# Author: Jorrel Khalil S. Aunario, jaunario at gmail.com
+# Date : 7 May 2012
+# Version 0.0.1
+# Licence GPL v3
+# Read and Write FSE weather files
+
+read.FSE <- function(fsefile, datacols=c("station_id", "year", "doy", "srad", "tmin", "tmax", "vaporp","wind","prec")){
+
+ fsewth <- new("weather")
+ is.sunshine <- FALSE
+ if (length(which(datacols %in% c("year", "doy")))!=2) stop("Required columns year and doy (day of year) not found.")
+
+ if(file.exists(fsefile) & file.info(fsefile)$size!=0){
+
+ dlines <- readLines(fsefile)
+ dlines <- gsub("\t", " ", dlines)
+ # get headers
+ ihdr <- grep("\\*", dlines)
+ hdr <- gsub("\\*", " ", dlines[min(ihdr):max(ihdr)])
+ hdr <- trim(gsub("\\?", " ", hdr))
+ hdr <- hdr[hdr!=""]
+
+ icol <- grep("1[[:space:]]+Station", hdr, ignore.case=TRUE)
+ if (length(grep("--", hdr))>0){
+ colinfo <- hdr[icol:(length(hdr)-1)]
+ } else{
+ colinfo <- hdr[icol:length(hdr)]
+ }
+ hdr <- hdr[1:(icol-1)]
+ # get station name
+ i <- grep("station", hdr, ignore.case=TRUE)
+ if (length(i)==0) {
+ i <- grep("location", hdr, ignore.case=TRUE)
+ }
+ fsewth at stn <- ifelse(!is.na(i[1]), trim(gsub("\\*", "", unlist(strsplit(hdr[i],":"))[2])),"Unknown")
+
+ # get source
+ i <- grep("source", hdr, ignore.case=TRUE)
+ fsewth at rmk <- ifelse(length(i)==1, trim(unlist(strsplit(hdr[i],":"))[2]),"")
+
+ # get station name
+ #i <- grep("source", hdr, ignore.case=TRUE)
+ #fsewth at rmk <- ifelse(length(i)==1, trim(unlist(strsplit(dlines[i],":"))[2]),"")
+
+ # get coordinates
+ coords <- as.numeric(unlist(strsplit(trim(dlines[max(ihdr)+1]),"[[:space:]]+")))
+ rm(dlines)
+ gc(verbose=FALSE)
+
+ fsewth at lon <- coords[1]
+ fsewth at lat <- coords[2]
+ fsewth at alt <- coords[3]
+
+ #dmatrix <- matrix(as.numeric(unlist(strsplit(trim(dlines[(max(ihdr)+2):length(dlines)]), "[[:space:]]+"))), ncol=length(colinfo), byrow=TRUE)
+ #dmatrix[dmatrix==-9999] <- NA
+ #dmatrix <- as.data.frame(dmatrix)
+
+ dmatrix <- read.table(fsefile, skip=max(ihdr)+1, na.strings="-9999", stringsAsFactors=FALSE)
+ colnames(dmatrix) <- datacols
+
+ # CHECK RADIATION UNITS THEN CONVERT TO MEGAJOULE/SQM/DAY IF NECESSARY
+
+ # Check if sunshine hours/duration
+ rad_var <- grep("sunshine[[:print:]]*", tolower(colinfo), ignore.case=TRUE)
+ if (length(rad_var)!=0){
+ dmatrix[,rad_var] <- round(sunhoursToSRad(dmatrix[,rad_var],dmatrix[,3],fsewth at lat, coords[4], coords[5]),2)
+ show.message("Sunshine duration", appendLF=TRUE)
+
+ } else {
+ rad_var <- grep("[[:print:]]*rad[[:print:]]*", tolower(colinfo), ignore.case=TRUE)
+ if(length(rad_var)!=0 & grepl("kj", colinfo[rad_var],ignore.case=TRUE)) {
+ dmatrix[,rad_var] <- round(dmatrix[,rad_var]/1000,2)
+ }
+
+ }
+
+ wdate <- dateFromDoy(dmatrix[,"doy"],dmatrix[,"year"])
+ fsewth at w <- cbind(wdate,as.data.frame(dmatrix[,4:length(datacols)]))
+ #fsewth at rmk <- ifelse(length(i)==1, trim(unlist(strsplit(dlines[i],":"))[2]),"")
+
+ } else {
+ stop(fsefile, " not found.")
+ }
+ return(fsewth)
+}
Modified: pkg/geoclimate/R/gsod.r
===================================================================
--- pkg/geoclimate/R/gsod.r 2012-04-04 09:13:12 UTC (rev 20)
+++ pkg/geoclimate/R/gsod.r 2012-05-18 09:48:56 UTC (rev 21)
@@ -5,12 +5,32 @@
# Current ftp site
GSOD.ftp <- "ftp://ftp.ncdc.noaa.gov/pub/data/gsod"
+# Reference to var values for parsing downloaded data
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(){
+GSOD.readStations <- function(stationfile=system.file("gsod_stations.csv", package="geoclimate"), rm.nodata=TRUE, rm.nocoords=TRUE){
+ show.message("Reading GSOD station info file.", appendLF=TRUE)
+ stations <- read.csv(stationfile, stringsAsFactors=FALSE)
+ if(rm.nodata) stations <- stations[-which(is.na(stations$BEGIN)),]
+ if(rm.nocoords) stations <- stations[-which(stations$LAT==-99999|is.na(stations$LAT)),]
+ stationid <- paste(sprintf("%06d",stations$USAF), sprintf("%05d", stations$WBAN), sep="-")
+ stations <- cbind(stationid,stations, stringsAsFactors=FALSE)
+
+ # Change to float
+ stations$LAT <- stations$LAT/1000
+ stations$LON <- stations$LON/1000
+ stations$ELEV..1M.[stations$ELEV..1M.==-99999] <- NA
+ stations$ELEV..1M. <- stations$ELEV..1M./10
+ # Rename elevation fieldname
+ colnames(stations)[colnames(stations)=="ELEV..1M."] <- "ELEV1M"
+ # Change to date
+ stations$BEGIN <- as.Date(as.character(stations$BEGIN), "%Y%m%d")
+ stations$END <- as.Date(as.character(stations$END), "%Y%m%d")
+ return(stations)
+}
+GSOD.stations <- GSOD.readStations()
+
+GSOD.updateStations <- function(){
success <- FALSE
if(!require(RCurl)){
show.message("Error: RCurl package not found.", appendLF=TRUE)
@@ -23,8 +43,7 @@
if (age<2){
show.message("GSOD station file is upto date.", appendLF=TRUE)
success <- TRUE
- } else {
-
+ } else {
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 {
@@ -33,94 +52,120 @@
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)
+ }
+ show.message("GSOD Stations info file update complete.", EL=TRUE, appendLF=TRUE)
success <- TRUE
}
}
}
}
-get.gsod <- function(year, station, savepath=getwd(), rm.existing=FALSE){
+#gsod.download <- function(gsodurl,fname=basename(gsodurl), ...){
+# dl.success <- FALSE
+# gsodzip <- withRetry(getBinaryURL(gsodurl), ...)
+# if (class(gsodzip)!="try-error") {
+# writeBin(gsodzip, fname)
+# dl.success <- TRUE
+# }
+# return(dl.success)
+#}
+get.gsod <- function(station, year=as.numeric(format(Sys.Date(),"%Y")), savepath=getwd(), rm.existing=FALSE,...){
+
+ # check for RCurl package
+ if(!require(RCurl)){
+ stop("RCurl package not found.")
+ }
+
+ # check for write permissions
+ if(!force.directories(savepath, recursive=TRUE)){
+ stop("Can't create download path.")
+ }
+
+ sindex <- grep(station, GSOD.stations$stationid)
+ #check if station exists
+ if (length(sindex)!=1){
+ stop("Can't find station ", station,"\nTry updating GSOD stations file.")
+ }
+
+ # prepare weather object
result <- new("weather")
+ result at stn <- paste(GSOD.stations$STATION.NAME[sindex], " (", station, ")", sep="")
+ result at lon <- GSOD.stations$LON[sindex]
+ result at lat <- GSOD.stations$LAT[sindex]
+ result at alt <- GSOD.stations$ELEV1M[sindex]
+
+ fname <- paste(station,"-",year,".op.gz", sep="")
+ ftpurl <- paste(GSOD.ftp, year, fname, sep="/")
- if(!force.directories(savepath, recursive=TRUE)){
- show.message("Error: Can't create download path.", appendLF=TRUE)
- } else if(!require(RCurl)){
- show.message("Error: RCurl package not found.", appendLF=TRUE)
- } else {
- fname <- paste(station,"-",year,".op.gz", sep="")
- ftpurl <- paste(GSOD.ftp, year, fname, sep="/")
- available <- withRetry(getURL(paste(GSOD.ftp,"/",year,"/",sep="")))
- if (!grepl(station, available)){
- show.message("Data not available on ", station, " for year ", year,".", appendLF=TRUE)
- } else {
- dl.success <- withRetry(download.file(ftpurl, destfile=paste(savepath,fname, sep="/"), mode="wb"))
-
- # Parse the gsod file if successfully downloaded
- if (dl.success==0){
- gz <- gzfile(paste(savepath,fname,sep="/"))
- dlines <- readLines(gz)
- close(gz)
-
- #Parsing the GSOD file
- for (i in 1:14){
- assign(GSOD.varrefs$variable[i], trim(substr(dlines[-1], GSOD.varrefs$stpos[i], GSOD.varrefs$enpos[i])))
- if(!is.na(GSOD.varrefs$missing[i])) {
- tmp <- get(GSOD.varrefs$variable[i])
- tmp[tmp==as.character(GSOD.varrefs$missing[i])] <- NA
- assign(GSOD.varrefs$variable[i],tmp)
- }
- }
+ # Download gsod file if necessary
+ if (!file.exists(paste(savepath,fname, sep="/"))){
+ dl <- withRetry(download.file(ftpurl, destfile = paste(savepath, fname, sep = "/"), mode = "wb", quiet = TRUE), ...)
+ } else if (rm.existing | file.info(paste(savepath, fname, sep="/"))$size==0){
+ # Remove existing downloaded file
+ file.remove(paste(savepath,fname, sep="/"))
+ dl <- withRetry(download.file(ftpurl, destfile = paste(savepath, fname, sep = "/"), mode = "wb", quiet = TRUE), ...)
+ }
+
+ gz <- gzfile(paste(savepath,fname,sep="/"))
+ dlines <- readLines(gz)
+ gz <- close(gz)
- wdate <- as.Date(YEARMODA,"%Y%m%d")
- gsod <- as.data.frame(wdate)
-
- # CLEAN UP CLIMATE DATA
- gsod$tavg <- round(FtoC(as.numeric(TEMP)),1)*10 # MEAN TEMP
- gsod$slpressure <- as.numeric(SLP)*10 # SEA LEVEL PRESSURE
- gsod$stpressure <- as.numeric(STP)*10 # STATION PRESSURE
- gsod$tdew <- round(FtoC(as.numeric(DEWP)),1)*10 # MEAN DEW POINT
- gsod$visibility <- round((as.numeric(VISIB) * 1.609344),1)*10 # VISIBILITY
-
- ##############################################
- # WINDSPEED NEEDED IN ORYZA2k
- gsod$wind <- round(as.numeric(WDSP) * 0.514444444,1)*10 # WIND SPEED
- gsod$maxwind <- round(as.numeric(MXSPD) * 0.514444444,1)*10 # MAX SUSTAINED SPEED
- gsod$gust <- round(as.numeric(GUST) * 0.514444444,1)*10 # MAX GUST
-
- ##############################################
- # MAX T NEEDED IN ORYZA2k
- gsod$tmax <- round(FtoC(as.numeric(MAX)),1)*10 # MAX T
-
- ##############################################
- # MIN 2 NEEDED IN ORYZA2k
- gsod$tmin <- round(FtoC(as.numeric(MIN)),1)*10 # MIN T
-
- ##############################################
- # RAINFALL NEEDED IN ORYZA2k
- gsod$prec <- round(as.numeric(PRCP)*100/25.4,1)*10 # RAINFALL
-
- ##############################################
- # SNOW DEPTH
- gsod$snowdepth <- round(as.numeric(SNDP)*100/25.4,1)*10 # convert to mm
-
- indicators <- matrix(as.numeric(unlist(strsplit(FRSHTT,""))),byrow=TRUE, ncol=6)
- colnames(indicators) <- c("ifog","irain","isnow","ihail","ithunder","itornado")
- gsod <- cbind(gsod, indicators, stringsAsFactors=FALSE)
- result <- new('weather')
- result at stn <- station
- # TODO: get from database?
- #result at lon <- x
- #result at lat <- y
- #result at alt <- alt
- result at w <- gsod
+ # Parse the gsod file if successfully downloaded
+ if (length(dlines)>0){
+
+ dat <- vector()
+ #Parsing the GSOD file
+ for (i in 1:14){
+ tmp <- trim(substr(dlines[-1], GSOD.varrefs$stpos[i], GSOD.varrefs$enpos[i]))
+ if(!is.na(GSOD.varrefs$missing[i])) {
+ tmp[tmp==as.character(GSOD.varrefs$missing[i])] <- NA
}
+ dat <- cbind(dat,tmp)
}
- }
+ colnames(dat) <- GSOD.varrefs$variable[1:14]
+ dat <- as.data.frame(dat, stringsAsFactors=FALSE)
+ gsod <- data.frame(tavg=numeric(nrow(dat)),slpressure=numeric(nrow(dat)),stpressure=numeric(nrow(dat)),tdew=numeric(nrow(dat)),visibility=numeric(nrow(dat)),wind=numeric(nrow(dat)),maxwind=numeric(nrow(dat)),gust=numeric(nrow(dat)),tmax=numeric(nrow(dat)),tmin=numeric(nrow(dat)),prec=numeric(nrow(dat)),snowdepth=numeric(nrow(dat)))
+ # CLEAN UP CLIMATE DATA
+ gsod$tavg <- round(FtoC(as.numeric(dat$TEMP)),1)*10 # MEAN TEMP
+ gsod$slpressure <- as.numeric(dat$SLP)*10 # SEA LEVEL PRESSURE
+ gsod$stpressure <- as.numeric(dat$STP)*10 # STATION PRESSURE
+ gsod$tdew <- round(FtoC(as.numeric(dat$DEWP)),1)*10 # MEAN DEW POINT
+ gsod$visibility <- round((as.numeric(dat$VISIB) * 1.609344),1)*10 # VISIBILITY
+
+ ##############################################
+ # WINDSPEED NEEDED IN ORYZA2k
+ gsod$wind <- round(as.numeric(dat$WDSP) * 0.514444444,1)*10 # WIND SPEED
+ gsod$maxwind <- round(as.numeric(dat$MXSPD) * 0.514444444,1)*10 # MAX SUSTAINED SPEED
+ gsod$gust <- round(as.numeric(dat$GUST) * 0.514444444,1)*10 # MAX GUST
+
+ ##############################################
+ # MAX T NEEDED IN ORYZA2k
+ gsod$tmax <- round(FtoC(as.numeric(dat$MAX)),1)*10 # MAX T
+
+ ##############################################
+ # MIN 2 NEEDED IN ORYZA2k
+ gsod$tmin <- round(FtoC(as.numeric(dat$MIN)),1)*10 # MIN T
+
+ ##############################################
+ # RAINFALL NEEDED IN ORYZA2k
+ gsod$prec <- round(as.numeric(dat$PRCP)*100/25.4,1)*10 # RAINFALL
+
+ ##############################################
+ # SNOW DEPTH
+ gsod$snowdepth <- round(as.numeric(dat$SNDP)*100/25.4,1)*10 # convert to mm
+
+ indicators <- matrix(as.numeric(unlist(strsplit(dat$FRSHTT,""))),byrow=TRUE, ncol=6)
+ colnames(indicators) <- c("ifog","irain","isnow","ihail","ithunder","itornado")
+
+ wdate <- as.Date(dat$YEARMODA,"%Y%m%d")
+
+ gsod <- cbind(wdate, gsod, indicators, stringsAsFactors=FALSE)
+ # TODO: get from database?
+ result at w <- gsod
+ } else {
+ # result at rmk <- paste("Download failed for", year)
+ result at rmk <- as.character(dl)
+ }
return(result)
}
Modified: pkg/geoclimate/R/upload.r
===================================================================
--- pkg/geoclimate/R/upload.r 2012-04-04 09:13:12 UTC (rev 20)
+++ pkg/geoclimate/R/upload.r 2012-05-18 09:48:56 UTC (rev 21)
@@ -22,115 +22,83 @@
return(success)
}
-upload.nasa <- function(dbasecon, nasa, setname='nasa_1d', ...){
+upload.nasa <- function(dbasecon, nasa, setname='nasa_1d'){
# TODO: support transaction
success <- FALSE
- if (class(nasa)=="weather"){
- inasa <- cbind(0,as.numeric(nasa at stn), nasa at w)
- colnames(inasa) <- c('id','cell', colnames(nasa at w))
- success <- .upload(dbasecon, inasa, tablename=setname)
+ if (class(nasa)!="weather"){
+ stop("Invalid nasa input. Should be class 'weather'")
}
+
+ inasa <- cbind(0,as.numeric(nasa at stn), nasa at w)
+ colnames(inasa) <- c('id','cell', colnames(nasa at w))
+ success <- .upload(dbasecon, inasa, tablename=setname)
return(success)
}
-upload.gsod <- function(connectionstring, year, setname="gsod_xd", stationtable="stations", dldir=getwd(), rm.download=FALSE){
- force.directories(dldir, recursive=TRUE)
-
- con <- odbcConnect(connectionstring)
- stations <- sqlFetch(con, stationtable, stringsAsFactors=FALSE)
+upload.gsod <- function(dbasecon, gsod, setname="gsod_xd"){
+ # TODO: support transaction
+ success <- FALSE
- tarfile <- paste(dldir, "/gsod_", year, ".tar", sep="")
- dlstart <- Sys.time()
- if(!file.exists(tarfile)) {
- show.message("Downloading ", tarfile,eol="\n")
- withRetry(download.file(paste(GSOD.ftp, year, "/gsod_", year, ".tar", sep=""), destfile=tarfile, mode="wb"))
- }
- dlend <- Sys.time()
+ if (class(gsod)!="weather"){
+ stop("Invalid gsod input. Should be class 'weather'")
+ }
+
+ igsod <- cbind(as.numeric(gsod at stn), gsod at w)
+ colnames(igsod) <- c('station_id', colnames(gsod at w))
+ success <- .upload(dbasecon, igsod, tablename=setname)
- gzdir <- paste(dldir, year, sep="/")
- force.directories(gzdir, recursive=TRUE)
-
- show.message("Decompressing gsod tar file",eol="\n")
- untar(tarfile,verbose=FALSE, exdir=gzdir, extras="--no-same-owner")
- gzfiles <- list.files(gzdir,pattern="*.*.gz")
- #gfile <- gzfiles[1]
- failed <- vector()
- procstart <- Sys.time()
- for (gfile in gzfiles){
-
- show.message("Reading ", gfile,eol="\r")
-
- station_id <- stations$station_id[match(substr(gfile,1,12), stations$station_code)]
- if(is.na(station_id)) {
- failed <- c(failed, gfile)
- next
- }
-
- gz <- gzfile(paste(gzdir,gfile,sep="/"))
- dlines <- readLines(gz)
- close(gz)
-
- #Parsing the GSOD file
- for (i in 1:14){
- assign(GSOD.varrefs$variable[i], trim(substr(dlines[-1], GSOD.varrefs$stpos[i], GSOD.varrefs$enpos[i])))
- if(!is.na(GSOD.varrefs$missing[i])) {
- tmp <- get(GSOD.varrefs$variable[i])
- tmp[tmp==as.character(GSOD.varrefs$missing[i])] <- NA
- assign(GSOD.varrefs$variable[i],tmp)
- }
- }
-
- wdate <- as.Date(YEARMODA,"%Y%m%d")
- gsod <- as.data.frame(wdate)
-
- # CLEAN UP CLIMATE DATA
- gsod$tavg <- round(FtoC(as.numeric(TEMP)),1)*10 # MEAN TEMP
- gsod$slpressure <- as.numeric(SLP)*10 # SEA LEVEL PRESSURE
- gsod$stpressure <- as.numeric(STP)*10 # STATION PRESSURE
- gsod$tdew <- round(FtoC(as.numeric(DEWP)),1)*10 # MEAN DEW POINT
- gsod$visibility <- round((as.numeric(VISIB) * 1.609344),1)*10 # VISIBILITY
-
- ##############################################
- # WINDSPEED NEEDED IN ORYZA2k
- gsod$wind <- round(as.numeric(WDSP) * 0.514444444,1)*10 # WIND SPEED
- gsod$maxwind <- round(as.numeric(MXSPD) * 0.514444444,1)*10 # MAX SUSTAINED SPEED
- gsod$gust <- round(as.numeric(GUST) * 0.514444444,1)*10 # MAX GUST
-
- ##############################################
- # MAX T NEEDED IN ORYZA2k
- gsod$tmax <- round(FtoC(as.numeric(MAX)),1)*10 # MAX T
-
- ##############################################
- # MIN 2 NEEDED IN ORYZA2k
- gsod$tmin <- round(FtoC(as.numeric(MIN)),1)*10 # MIN T
-
- ##############################################
- # RAINFALL NEEDED IN ORYZA2k
- gsod$prec <- round(as.numeric(PRCP)*100/25.4,1)*10 # RAINFALL
-
- ##############################################
- # SNOW DEPTH
- gsod$snowdepth <- round(as.numeric(SNDP)*100/25.4,1)*10 # convert to mm
-
- indicators <- matrix(as.numeric(unlist(strsplit(FRSHTT,""))),byrow=TRUE, ncol=6)
- colnames(indicators) <- c("ifog","irain","isnow","ihail","ithunder","itornado")
- gsod <- cbind(station_id, gsod, indicators)
- show.message("Uploading parsed data from ", stations$station_code[stations$station_id==station_id],eol="\r")
- sqlSave(con,gsod, tablename=setname, rownames=FALSE, append=TRUE)
- stations$begin[stations$station_id==station_id] <- min(stations$begin[stations$station_id==station_id],min(wdate),na.rm=TRUE)
- stations$end[stations$station_id==station_id] <- max(stations$end[stations$station_id==station_id],max(wdate),na.rm=TRUE)
- show.message("Updating station information",eol="\r")
- sqlUpdate(con,stations[stations$station_id==station_id,],stationtable)
- show.message("Upload for station ", stations$station_code[stations$station_id==station_id], " done! (",as.character(min(wdate))," to ",as.character(max(wdate)),")",eol="\n")
- }
- procend <- Sys.time()
- gsodlog <- c(paste("Download Start:", dlstart),paste("Download End:",dlend),paste("Download time:", round(difftime(dlend,dlstart, unit="mins"),2),"mins.\n"),
- paste("Process Start:", procstart),paste("Process End:",procend),paste("Process time:", round(difftime(procend,procstart, unit="mins"),2),"mins.\n"),
- paste("Files in archive:", length(gzfiles)), paste("Files with no station info:", length(failed)),failed)
- writeLines(gsodlog, paste(dldir,paste("gsod_log_",year,".txt",sep=""),sep="/"))
- if (rm.download) unlink(tarfile)
- unlink(gzdir,recursive=TRUE)
- # STATION UPDATE
- con <- odbcClose(con)
+ return(success)
}
+
+upload.FSE <- function(dbasecon, clim, setname, stations=NA, has.AIid=FALSE){
+ add <- success <- FALSE
+
+
+ if(class(clim)!="weather"){
+ stop("Invalid clim input. Should be class 'weather'")
+ }
+
+ if(class(dbasecon)!="RODBC"){
+ stop("Invalid dbasecon input. Should be class 'RODBC'")
+ }
+
+ if (!isOpen(dbasecon)) dbasecon <- odbcReConnect(dbasecon)
+
+ if(!is.na(stations) & clim at stn!="Unknown"){
+ station_info <- sqlQuery(dbasecon, paste("SELECT * FROM", stations, "WHERE lat =",clim at lat, "AND lon =",clim at lon), stringsAsFactors=FALSE)
+
+ if (nrow(station_info)==0){
+ add <- TRUE
+ station_info[1,] <- NA
+ station_info$station_id <- sqlQuery(dbasecon, paste("SELECT IF(MAX(station_id) IS NULL,1,MAX(station_id)+1) station_id FROM", stations))$station_id
+ station_info$station_name <- clim at stn
+ station_info$lat <- clim at lat
+ station_info$lon <- clim at lon
+ station_info$elev <- ifelse(clim at alt==-9999,NA,clim at alt)
+ station_info$pixel_1d <- cellFromXY(raster(),station_info[,c("lon", "lat")])
+ station_info$remarks <- ifelse(clim at rmk=="", NA, paste(Sys.time(), ": ", clim at rmk, sep=""))
+ } else if(clim at rmk!="" & length(grep(clim at rmk,station_info$remarks))==0){
+ station_info <- station_info[,c("station_id","begin","end","remarks","updated")]
+ station_info$remarks <- paste(station_info$remarks, "\n", Sys.time(),": ",clim at rmk, sep="")
+ } else {
+ station_info <- station_info[,c("station_id","begin","end", "updated")]
+ }
+ station_info$begin <- min(as.Date(station_info$begin), clim at w$wdate, na.rm=TRUE)
+ station_info$end <- max(as.Date(station_info$end), clim at w$wdate, na.rm=TRUE)
+ station_info$updated <- NA
+ station_id <- station_info$station_id
+ dat <- cbind(station_id, clim at w)
+ } else if(clim at stn!="Unknown"){
+ stop("Invalid station name. Should not be 'Unknown'")
+ }
+ if(has.AIid){
+ id <- 0
+ dat <- cbind(id, dat)
+ }
+
+ success <- .upload(dbasecon, dat, tablename=setname)
+
+ if (success & !is.na(stations) & add) sqlSave(dbasecon, station_info, tablename=stations, append=TRUE, rownames=FALSE) else if (success & !is.na(stations)) sqlUpdate(dbasecon, station_info, tablename=stations)
+ return(success)
+}
\ No newline at end of file
More information about the Rodbcext-commits
mailing list