minor fixes to annual and wetmean function to cope with no rainy days

metno · Nov 6, 2023 · f6bc71a · f6bc71a
1 parent 60d66b3
commit f6bc71a
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 14 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: esd
-Version: 1.10.56
-Date: 2023-10-06
+Version: 1.10.57
+Date: 2023-11-05
 Title: Climate analysis and empirical-statistical downscaling (ESD) package for monthly and daily data
 Author: Rasmus E. Benestad, Abdelkader Mezghani, Kajsa M. Parding, Helene B. Erlandsen, Ketil Tunheim, and Cristian Lussana    
 Maintainer: Rasmus E. Benestad <rasmus.benestad@met.no>

diff --git a/R/as.annual.R b/R/as.annual.R
@@ -194,7 +194,7 @@ annual.default <- function(x,FUN='mean',na.rm=TRUE, nmin=NULL,start=NULL,...,
   } else {
     z <- zoo(matrix(rep(NA,ncol(y)*length(it)),
                     ncol=ncol(y), nrow=length(it)),
-	     order.by=it)
+             order.by=it)
     z[is.element(it,index(y)),] <- y
   }
   y <- z; rm('z')
@@ -233,11 +233,13 @@ annual.default <- function(x,FUN='mean',na.rm=TRUE, nmin=NULL,start=NULL,...,
     bad <- n<nmin
     #bad <- coredata(n)==0
     #coredata(n)[bad] <- 1
-    std.err <- 2*coredata(y)/sqrt(coredata(n)-1)
-    std.err[bad] <- NA
-    attributes(std.err) <- NULL
-    dim(std.err) <- dim(y)
-    attr(y,'standard.error') <- zoo(std.err,order.by=index(y))
+    std.err <- try(2*coredata(y)/sqrt(coredata(n)-1))
+    if (!inherits(std.err,'try-error')) { 
+      std.err[bad] <- NA
+      attributes(std.err) <- NULL
+      dim(std.err) <- dim(y)
+      attr(y,'standard.error') <- zoo(std.err,order.by=index(y))
+    }
   } else if (FUN=="mean") {
     if (verbose) print("mean")
     sigma <- aggregate(X, year, FUN='sd', ...,
@@ -251,10 +253,12 @@ annual.default <- function(x,FUN='mean',na.rm=TRUE, nmin=NULL,start=NULL,...,
     #               regular = regular, frequency = frequency)
     #bad <- coredata(n)==0
     #coredata(n)[bad] <- 1
-    std.err <- 2*coredata(sigma)/sqrt(coredata(n)-1)
-    std.err[bad] <- NA
-    attributes(std.err) <- NULL
-    dim(std.err) <- dim(sigma)
+    std.err <- try(2*coredata(sigma)/sqrt(coredata(n)-1))
+    if (!inherits(std.err,'try-error')) { 
+      std.err[bad] <- NA
+      attributes(std.err) <- NULL
+      dim(std.err) <- dim(sigma)
+    }
     attr(y,'standard.error') <- zoo(std.err,order.by=index(sigma))
   } else if (FUN=="HDD") {
     attr(y,'variable') <- rep('HDD',d[2])

diff --git a/R/write2ncdf.R b/R/write2ncdf.R
@@ -493,7 +493,7 @@ combinelist <- function(x,y,verbose=FALSE) {
   return(x)
 }
 
-StationSumStats <- function(x,missval,ns=300,verbose=FALSE,start='Jan') {
+StationSumStats <- function(x,missval=-999,ns=300,verbose=FALSE,start='Jan') {
   if (verbose) print(paste('StationSumStats - precip?',is.precip(x)))
 
   if (is.null(dim(x))) {
@@ -520,7 +520,7 @@ StationSumStats <- function(x,missval,ns=300,verbose=FALSE,start='Jan') {
                     paste(range(js),collapse='-')))
         print(is.precip(subset(x,is=js))); str(subset(x,is=js,verbose=TRUE))
       }
-      y <- StationSumStats(subset(x,is=js),verbose=verbose)
+      y <- StationSumStats(subset(x,is=js),missval=missval,verbose=verbose)
       if (verbose) print(names(y))
       if (is.null(Y)) Y <- y else Y <- combinelist(Y,y,verbose=verbose)
     }
@@ -579,6 +579,7 @@ StationSumStats <- function(x,missval,ns=300,verbose=FALSE,start='Jan') {
       mu.mam <- apply(annual(subset(x,it='mam'),'wetmean',nmin=75),2,'mean',na.rm=TRUE)
       mu.jja <- apply(annual(subset(x,it='jja'),'wetmean',nmin=75),2,'mean',na.rm=TRUE)
       mu.son <- apply(annual(subset(x,it='son'),'wetmean',nmin=75),2,'mean',na.rm=TRUE)
+      if (verbose) print('wet-day frequency')
       fw <- apply(100*annual(x,'wetfreq',start=start),2,'mean',na.rm=TRUE)
       fw.djf <- apply(100*annual(subset(x,it='djf'),'wetfreq',nmin=75),2,'mean',na.rm=TRUE)
       fw.mam <- apply(100*annual(subset(x,it='mam'),'wetfreq',nmin=75),2,'mean',na.rm=TRUE)