[R] Function that is giving me a headache- any help appreciated (automatic read )

John Kane jrkrideau at yahoo.ca
Tue May 18 19:00:34 CEST 2010


I don't think you can do this
precipitation!="NA")

have a look at ?is.na

--- On Tue, 5/18/10, stephen sefick <ssefick at gmail.com> wrote:

> From: stephen sefick <ssefick at gmail.com>
> Subject: [R] Function that is giving me a headache- any help appreciated (automatic read )
> To: r-help at r-project.org
> Received: Tuesday, May 18, 2010, 12:38 PM
> note: whole function is below- I am
> sure I am doing something silly.
> 
> when I use it like USGS(input="precipitation") it is
> choking on the
> 
> 
> precip.1 <- subset(DF, precipitation!="NA")
> b <- ddply(precip.1$precipitation,
> .(precip.1$gauge_name), cumsum)
> DF.precip <- precip.1
> DF.precip$precipitation <- b$.data
> 
> part, but runs fine outside of the function:
> 
> days=7
> input="precipitation"
> require(chron)
> require(gsubfn)
> require(ggplot2)
> require(plyr)
> #021973269 is the Waynesboro Gauge on the Savannah River
> Proper (SRS)
> #02102908 is the Flat Creek Gauge (ftbrfcms)
> #02133500 is the Drowning Creek (ftbrbmcm)
> #02341800 is the Upatoi Creek Near Columbus (ftbn)
> #02342500 is the Uchee Creek Near Fort Mitchell (ftbn)
> #02203000 is the Canoochee River Near Claxton (ftst)
> #02196690 is the Horse Creek Gauge at Clearwater, S.C.
> 
> a <- "http://waterdata.usgs.gov/nwis/uv?format=rdb&period="
> b <-
> "&site_no=021973269,02102908,02133500,02341800,02342500,02203000,02196690"
> z <- paste(a, days, b, sep="")
> L <- readLines(z)
> 
> #look for the data with USGS in front of it (this take
> advantage of
> #the agency column)
> L.USGS <- grep("^USGS", L, value = TRUE)
> DF <- read.table(textConnection(L.USGS), fill = TRUE)
> colnames(DF) <- c("agency", "gauge", "date", "time",
> "time_zone",
> "gauge_height",
> "discharge", "precipitation")
> pat <- "^# +USGS +([0-9]+) +(.*)"
> L.DD <- grep(pat, L, value = TRUE)
> library(gsubfn)
> DD <- strapply(L.DD, pat, c, simplify = rbind)
> DDdf <- data.frame(gauge = as.numeric(DD[,1]),
> gauge_name = DD[,2])
> both <- merge(DF, DDdf, by = "gauge", all.x = TRUE)
> 
> dts <- as.character(both[,"date"])
> tms <- as.character(both[,"time"])
> date_time <- as.chron(paste(dts, tms), "%Y-%m-%d
> %H:%M")
> DF <- data.frame(Date=as.POSIXct(date_time), both)
> #change precip to numeric
> DF[,"precipitation"] <-
> as.numeric(as.character(DF[,"precipitation"]))
> 
> precip.1 <- subset(DF, precipitation!="NA")
> b <- ddply(precip.1$precipitation,
> .(precip.1$gauge_name), cumsum)
> DF.precip <- precip.1
> DF.precip$precipitation <- b$.data
> 
> #discharge
> if(input=="data"){
> 
> return(DF)
> 
> }else{
> 
> qplot(Date, discharge, data=DF,
> geom="line", ylab="Date")+facet_wrap(~gauge_name,
> scales="free_y")+coord_trans(y="log10")}
> 
> if(input=="precipitation"){
> #precipitation
> qplot(Date, precipitation, data=DF.precip,
> geom="line")+facet_wrap(~gauge_name, scales="free_y")
> 
> }else{
> 
> qplot(Date, discharge, data=DF,
> geom="line", ylab="Date")+facet_wrap(~gauge_name,
> scales="free_y")+coord_trans(y="log10")}
> 
> below is the whole function:
> 
> USGS <- function(input="discharge", days=7){
> require(chron)
> require(gsubfn)
> require(ggplot2)
> require(plyr)
> #021973269 is the Waynesboro Gauge on the Savannah River
> Proper (SRS)
> #02102908 is the Flat Creek Gauge (ftbrfcms)
> #02133500 is the Drowning Creek (ftbrbmcm)
> #02341800 is the Upatoi Creek Near Columbus (ftbn)
> #02342500 is the Uchee Creek Near Fort Mitchell (ftbn)
> #02203000 is the Canoochee River Near Claxton (ftst)
> #02196690 is the Horse Creek Gauge at Clearwater, S.C.
> 
> a <- "http://waterdata.usgs.gov/nwis/uv?format=rdb&period="
> b <-
> "&site_no=021973269,02102908,02133500,02341800,02342500,02203000,02196690"
> z <- paste(a, days, b, sep="")
> L <- readLines(z)
> 
> #look for the data with USGS in front of it (this take
> advantage of
> #the agency column)
> L.USGS <- grep("^USGS", L, value = TRUE)
> DF <- read.table(textConnection(L.USGS), fill = TRUE)
> colnames(DF) <- c("agency", "gauge", "date", "time",
> "time_zone",
> "gauge_height",
> "discharge", "precipitation")
> pat <- "^# +USGS +([0-9]+) +(.*)"
> L.DD <- grep(pat, L, value = TRUE)
> library(gsubfn)
> DD <- strapply(L.DD, pat, c, simplify = rbind)
> DDdf <- data.frame(gauge = as.numeric(DD[,1]),
> gauge_name = DD[,2])
> both <- merge(DF, DDdf, by = "gauge", all.x = TRUE)
> 
> dts <- as.character(both[,"date"])
> tms <- as.character(both[,"time"])
> date_time <- as.chron(paste(dts, tms), "%Y-%m-%d
> %H:%M")
> DF <- data.frame(Date=as.POSIXct(date_time), both)
> #change precip to numeric
> DF[,"precipitation"] <-
> as.numeric(as.character(DF[,"precipitation"]))
> 
> precip.1 <- subset(DF, precipitation!="NA")
> b <- ddply(precip.1$precipitation,
> .(precip.1$gauge_name), cumsum)
> DF.precip <- precip.1
> DF.precip$precipitation <- b$.data
> 
> #discharge
> if(input=="data"){
> 
> return(DF)
> 
> }else{
> 
> qplot(Date, discharge, data=DF,
> geom="line", ylab="Date")+facet_wrap(~gauge_name,
> scales="free_y")+coord_trans(y="log10")}
> 
> if(input=="precipitation"){
> #precipitation
> qplot(Date, precipitation, data=DF.precip,
> geom="line")+facet_wrap(~gauge_name, scales="free_y")
> 
> }else{
> 
> qplot(Date, discharge, data=DF,
> geom="line", ylab="Date")+facet_wrap(~gauge_name,
> scales="free_y")+coord_trans(y="log10")}
> 
> }
> 
> 
> -- 
> Stephen Sefick
> 
> Let's not spend our time and resources thinking about
> things that are
> so little or so large that all they really do for us is
> puff us up and
> make us feel like gods.  We are mammals, and have not
> exhausted the
> annoying little problems of being mammals.
> 
>            
>            
>         -K. Mullis
> 
> ______________________________________________
> R-help at r-project.org
> mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained,
> reproducible code.
> 





More information about the R-help mailing list