numerous additions

DESCRIPTION

@@ -9,7 +9,7 @@ Description: Classes and methods for modelling and simulation of
     <doi:10.1111/j.1467-9892.2009.00617.x>, Boshnakov (1996)
     <doi:10.1111/j.1467-9892.1996.tb00281.x>.
 Version: 0.15-0
-Date: 2020-04-18
+Date: 2020-06-03
 Author: Georgi N. Boshnakov
 Maintainer: Georgi N. Boshnakov <georgi.boshnakov@manchester.ac.uk>
 Depends: R (>= 3.5.0)
@@ -18,14 +18,14 @@ Imports: methods, sarima, Matrix, BB, PolynomF (>= 2.0-2), gbutils, zoo, xts, st
 Suggests: testthat, pear, fUnitRoots, partsm, knitr, rmarkdown
 RdMacros: Rdpack
 LazyData: yes
-URL: https://geobosh.github.io/pcts  https://github.com/GeoBosh/pcts
+URL: https://geobosh.github.io/pcts (website)  https://github.com/GeoBosh/pcts (devel)
 BugReports: https://github.com/GeoBosh/pcts/issues
 License: GPL (>= 2)
 Collate:
     utils.R test1.r PeriodicCalc.R pcstat.R pc00smallutil.r pc02filters.r
     pc03simu.r acfsums.R pcls.R pcarma_model.R pcarma_acf.R
     generics.R autocovariances.R classCycle.R pcFilterClasses.R
     PeriodicClasses.R cyclic.R FittedPeriodicModels.R fitPM.R pcTest.R
-    PeriodicVector.R sim.R optimcore.R
+    PeriodicVector.R sim.R optimcore.R trig.R
 RoxygenNote: 7.1.0
 VignetteBuilder: knitr

NAMESPACE

@@ -6,11 +6,11 @@ importFrom(gbutils,nposargs,isargunnamed,isNA)
 
 importFrom(graphics, boxplot, layout, par, points, lines, axis, mtext)
 importFrom(utils, capture.output, str)
-importFrom(stats, ARMAacf, Box.test, C, as.formula,
+importFrom(stats, complete.cases, ARMAacf, Box.test, C, as.formula,
            frequency, start, end, cycle, deltat, time, window, "window<-",
            lm, na.exclude, nls, optim,
            pchisq, pnorm, qnorm, rnorm, runif,
-           residuals, fitted, predict, printCoefmat,
+           residuals, fitted, predict, printCoefmat, weighted.residuals,
            ts, as.ts, monthplot)
 
 importFrom(lubridate, minutes, hm, ymd,  is.Date, weeks, days,  period,
@@ -77,12 +77,20 @@ S3method(availStart, matrix)
 S3method(availEnd, default)
 S3method(availEnd, matrix)
 
+## zoo::na.trim
+S3method(na.trim, PeriodicTS)
+S3method(na.trim, PeriodicMTS)
+
+
 S3method(residuals, FittedPeriodicArModel)
 
 S3method(residuals, FittedPM)
 S3method(fitted, FittedPM)
 S3method(predict, FittedPM)
 
+S3method(predict, SubsetPM)
+
+
 exportMethods(
     head,
     tail,
@@ -100,7 +108,12 @@ exportMethods(
     sigmaSq,
 
     as_date,
-    as_datetime
+    as_datetime,
+
+    coef,
+    residuals,
+    fitted,
+    vcov
 )
 
 # exportClassPattern("^[^\\.]")
@@ -169,7 +182,9 @@ exportClasses(
   VirtualPeriodicStationaryModel,
   VirtualPeriodicWhiteNoiseModel,
   zoo,
-  zooreg
+  zooreg,
+
+  SubsetPM
 )
 
 
@@ -348,9 +363,13 @@ export(
   , meanvarcheck
 
   , Cyclic
-      # these don't get registered without exporting                   
-      # something related to base:as.Date being masked by zoo::as.Date?    
-  # , as.Date.PeriodicTimeSeries
+    ## these don't get registered without exporting                   
+    ## something related to base:as.Date being masked by zoo::as.Date?
+    ##    I am importing zoo and zoo::as.Date, hence calls from inside the package use that.
+    ##    However, if I don't reexport zoo::as.Date, then calls outside the package will be to    ##    base::as.Date.
+    ## So, reexport zoo::as.Date().    
+    ## TODO: selectively import from zoo?
+  , as.Date
   , as.Date.Cyclic            
   , as.Date.PeriodicTimeSeries
 
@@ -393,5 +412,7 @@ export(
 
     modelCoef
 
-
+, fit_trigPAR_optim
+, pcts_exdata
+, na.trim # from zoo
 )

NEWS.md

@@ -1,6 +1,10 @@
 # Version 0.15.0
 
-- consolidate the dependencies.
+- new methods for `zoo::na.trim`.
+
+- new subset PAR models with trigonometric parameterisation.
+
+- consolidated the dependencies.
 
 - vastly improved support for dates/times. 
 

R/classCycle.R

@@ -897,6 +897,11 @@ as.POSIXct.Cyclic <- function(x, ...){
     .cycle_and_pair2time(x@cycle, x@pcstart)
 }
 
+setMethod("as_date", "Cyclic",
+          function(x, ...){
+              as_date(as_datetime(x, ...))
+          })
+
 Pctime <- function(x, cycle, ...){
     if(missing(cycle)){
         if(is(x, "Cyclic")){ # TODO: separate handling for PeriodicTimeSeries

R/cyclic.R

@@ -862,24 +862,29 @@ setMethod("tail", "PeriodicTimeSeries",
               window(x, start = start)
           })
 
-availStart <- function(x) UseMethod("availStart")
-availStart.default <- function(x){
+availStart <- function(x, any = TRUE) UseMethod("availStart")
+availStart.default <- function(x, any = TRUE){
     ind <- match(FALSE, is.na(as.vector(x)))
     if(is.na(ind))
         stop("No non-missing values in x")
     ind2pctime(ind, start(x), nSeasons(x))
 }
 
-availStart.matrix <- function(x){
+availStart.matrix <- function(x, any = TRUE){
     m <- as.matrix(x)
-    ind <- min(apply(m, 2, function(obj) match(FALSE, is.na(obj)) ))
+    ind <- if(any)
+               min(apply(m, 2, function(obj) match(FALSE, is.na(obj)) ))
+           else # all
+               match(TRUE, complete.cases(m))
+
     if(is.na(ind))
-        stop("No non-missing values in x")
+        stop(if(any) "No non-missing values in x" else "No complete cases in x" )
+
     ind2pctime(ind, start(x), nSeasons(x))
 }
 
-availEnd <- function(x) UseMethod("availEnd")
-availEnd.default <- function(x){
+availEnd <- function(x, any = TRUE) UseMethod("availEnd")
+availEnd.default <- function(x, any = TRUE){
     y <- rev(as.vector(x))
     ind <- match(FALSE, is.na(y))
     if(is.na(ind))
@@ -888,15 +893,42 @@ availEnd.default <- function(x){
     ind2pctime(ind, start(x), nSeasons(x))
 }
 
-availEnd.matrix <- function(x){
+availEnd.matrix <- function(x, any = TRUE){
     m <- as.matrix(x)
-    ind <- min(apply(m, 2, function(obj) match(FALSE, is.na(rev(obj))) ))
+    ## TODO: use complete.cases()
+    ind <- if(any)
+               min(apply(m, 2, function(obj) match(FALSE, is.na(rev(obj))) ))
+           else
+               match(TRUE, rev(complete.cases(m)))
+
     if(is.na(ind))
-        stop("No non-missing values in x")
+        stop(if(any) "No non-missing values in x" else "No complete cases in x" )
+
     ind <- nrow(m) - ind + 1
     ind2pctime(ind, start(x), nSeasons(x))
 }
 
+na.trim.PeriodicTS <- function (object, sides = c("both", "left", "right"), ...){
+    switch(match.arg(sides),
+           both = window(object, start = availStart(object), end = availEnd(object)),
+           left = window(object, start = availStart(object)),
+           right = window(object, end = availEnd(object))
+           )
+}
+
+na.trim.PeriodicMTS <-
+    function (object, sides = c("both", "left", "right"), is.na = c("any", "all"), ...){
+        any <- match.arg(is.na) == "all"
+        sides <- match.arg(sides)
+        if(sides != "right")  start <- availStart(object, any)
+        if(sides != "left")   end <- availEnd(object, any)
+        switch(sides,
+               both = window(object, start = start, end = end),
+               left = window(object, start = start),
+               right = window(object, end = end)
+               )
+    }
+
 setMethod("plot", c(x = "PeriodicTS", y = "missing"),
           function(x, y, main = NULL, ...){
               ## for now just call the base "ts" method