cleared last warning by switched class() for 'is()' and added to NA…

…MESPACE 0 errors ✔ | 0 warnings ✔ | 0 notes ✔ R CMD check succeeded
braverock · Feb 4, 2024 · c657121 · c657121
1 parent aa0db8f
commit c657121
Show file tree

Hide file tree

Showing 7 changed files with 318 additions and 319 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -25,6 +25,7 @@ Imports:
     lars,
     lattice,
     leaps,
+    methods,
     parallel,
     PerformanceAnalytics,
     RCurl,

diff --git a/NAMESPACE b/NAMESPACE
@@ -153,6 +153,7 @@ importFrom(lattice,panel.xyplot)
 importFrom(lattice,strip.custom)
 importFrom(lattice,xyplot)
 importFrom(leaps,regsubsets)
+importFrom(methods,is)
 importFrom(parallel,clusterEvalQ)
 importFrom(parallel,clusterExport)
 importFrom(parallel,detectCores)

diff --git a/R/fitFfmDT.R b/R/fitFfmDT.R
@@ -193,7 +193,7 @@ standardizeExposures <- function(specObj,
   weight.var <- specObj$weight.var
   dataDT <- data.table::copy(specObj$dataDT) # hard_copy
   # we did have a copy but do we really need a full  copy, reference should be oka here
-  if (class(specObj) != "ffmSpec") {
+  if (is(specObj) != "ffmSpec") {
     stop("specObj must be class ffmSpec")
   }
   Std.Type = toupper(Std.Type[1])
@@ -711,6 +711,8 @@ fitFfmDT <- function(ffMSpecObj,
 #' @details this function operates on the specObje data and the output of fitFfm
 #' to get information on the fundamental factor.
 #'
+#' @importFrom methods is
+#'
 #' @seealso \code{\link{specFfm}} and \code{\link{fitFfmDT}} for information on the definition of the specFfm
 #' object and the usage of fitFfmDT.
 #' @importFrom RobStatTM covRob
@@ -999,15 +1001,8 @@ extractRegressionStats <- function(specObj, fitResults, full.resid.cov=FALSE){
   class(result) <- "ffm"
   return(result)
 
-
-
-
 }
 
-
-
-
-
 #' @title calcFLAM
 #'
 #' @description function to calculate fundamental law of active management
@@ -1287,7 +1282,7 @@ convert.ffmSpec <- function(SpecObj, FitObj, RegStatsObj, ...) {
 
   # clean up
 
-  class(ffmObj) <- "ffm"
+class(ffmObj) <- "ffm"
 
   return(ffmObj)
 

diff --git a/R/paFm.r b/R/paFm.r
@@ -1,114 +1,115 @@
 #' @title Compute cumulative mean attribution for factor models
-#' 
-#' @description Decompose total returns into returns attributed to factors and 
-#' specific returns. An object of class \code{"pafm"} is generated, with 
+#'
+#' @description Decompose total returns into returns attributed to factors and
+#' specific returns. An object of class \code{"pafm"} is generated, with
 #' methods for generic functions \code{plot}, \code{summary} and \code{print}.
-#' 
-#' @details Total returns can be decomposed into returns attributed to factors 
+#'
+#' @details Total returns can be decomposed into returns attributed to factors
 #' and specific returns. \cr \eqn{R_t = \sum  b_k * f_kt + u_t, t=1...T} \cr
-#' \code{b_k} is exposure to factor k and \code{f_kt} is factor k's return at 
-#' time t. The return attributed to factor k is \code{b_k * f_kt} and specific 
-#' return is \code{u_t}. 
-#' 
+#' \code{b_k} is exposure to factor k and \code{f_kt} is factor k's return at
+#' time t. The return attributed to factor k is \code{b_k * f_kt} and specific
+#' return is \code{u_t}.
+#'
 #' @importFrom PerformanceAnalytics checkData Return.cumulative chart.TimeSeries
 #' @importFrom xts xts
 #' @importFrom zoo index
-#' 
+#' @importFrom methods is
+#'
 #' @param fit an object of class \code{tsfm}, \code{sfm} or \code{ffm}.
 #' @param ... other arguments/controls passed to the fit methods.
-#' 
+#'
 #' @return The returned object is of class \code{"pafm"} containing
 #' \item{cum.ret.attr.f}{N X K matrix of cumulative return attributed to
 #' factors.}
 #' \item{cum.spec.ret}{length-N vector of cumulative specific returns.}
 #' \item{attr.list}{list of time series of attributed returns for every
 #' portfolio.}
-#' 
+#'
 #' @author Yi-An Chen and Sangeetha Srinivasan
-#' 
-#' @references Grinold, R. and Kahn, R. (1999) Active Portfolio Management: A 
-#' Quantitative Approach for Producing Superior Returns and Controlling Risk. 
+#'
+#' @references Grinold, R. and Kahn, R. (1999) Active Portfolio Management: A
+#' Quantitative Approach for Producing Superior Returns and Controlling Risk.
 #' McGraw-Hill.
-#' 
-#' @seealso \code{\link{fitTsfm}}, \code{\link{fitFfm}} 
+#'
+#' @seealso \code{\link{fitTsfm}}, \code{\link{fitFfm}}
 #' for the factor model fitting functions.
-#' 
-#' The \code{pafm} methods for generic functions: 
-#' \code{\link{plot.pafm}}, \code{\link{print.pafm}} and 
-#' \code{\link{summary.pafm}}. 
-#' 
+#'
+#' The \code{pafm} methods for generic functions:
+#' \code{\link{plot.pafm}}, \code{\link{print.pafm}} and
+#' \code{\link{summary.pafm}}.
+#'
 #' @examples
 #' data(managers, package = 'PerformanceAnalytics')
-#' fit <- fitTsfm(asset.names=colnames(managers[, (1:6)]), 
-#'                factor.names=c("EDHEC LS EQ","SP500 TR"), 
+#' fit <- fitTsfm(asset.names=colnames(managers[, (1:6)]),
+#'                factor.names=c("EDHEC LS EQ","SP500 TR"),
 #'                data=managers)
 #' # without benchmark
 #' paFm(fit)
-#' 
+#'
 #' @export
-#' 
+#'
 
 paFm <- function(fit, ...) {
-  
+
   # check input object validity
   if (!inherits(fit, c("tsfm", "sfm", "ffm"))) {
     stop("Invalid argument: fit should be of class 'tsfm', 'sfm' or 'ffm'.")
   }
-  
-  # TSFM chunk  
-  
-  if (class(fit)=="tsfm") {
-    
+
+  # TSFM chunk
+
+  if (is(fit)=="tsfm") {
+
     # return attributed to factors
     cum.attr.ret <- fit$beta
     cum.spec.ret <- fit$alpha
     factorNames <- fit$factor.names
     fundNames <- fit$asset.names
-    
+
     attr.list <- list()
-    
+
     for (k in fundNames) {
       fit.lm <- fit$asset.fit[[k]]
-      
+
       ## extract information from lm, lmRob or lars object
       reg.xts <- na.omit(fit$data[, c(k, factorNames)])
       dates <- as.Date(zoo::index(reg.xts))
       actual.xts <- xts::xts(fit.lm$model[1], dates)
       # attributed returns
-      # active portfolio management p.512 17A.9 
+      # active portfolio management p.512 17A.9
       # top-down method
-      
+
       cum.ret <- PerformanceAnalytics::Return.cumulative(actual.xts)
       # setup initial value
       attr.ret.xts.all <- xts::xts(order.by = dates)
-      
+
       for ( i in factorNames ) {
-        
+
         if (is.na(fit$beta[k, i])) {
           cum.attr.ret[k, i] <- NA
-          attr.ret.xts.all <- xts::xts(x = rep(NA, length(dates)), 
+          attr.ret.xts.all <- xts::xts(x = rep(NA, length(dates)),
                                   order.by = dates)
-                                    
+
         } else {
-          attr.ret.xts <- actual.xts - 
-            xts::xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), dates)  
-          cum.attr.ret[k, i] <- cum.ret - 
-            PerformanceAnalytics::Return.cumulative(actual.xts-attr.ret.xts)  
+          attr.ret.xts <- actual.xts -
+            xts::xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), dates)
+          cum.attr.ret[k, i] <- cum.ret -
+            PerformanceAnalytics::Return.cumulative(actual.xts-attr.ret.xts)
           attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
         }
       }
-      
-      # specific returns    
-      spec.ret.xts <- actual.xts - 
-        xts::xts(as.matrix(fit.lm$model[,factorNames])%*%as.matrix(fit.lm$coef[-1]), 
+
+      # specific returns
+      spec.ret.xts <- actual.xts -
+        xts::xts(as.matrix(fit.lm$model[,factorNames])%*%as.matrix(fit.lm$coef[-1]),
             dates)
       cum.spec.ret[k,1] <- cum.ret - PerformanceAnalytics::Return.cumulative(actual.xts-spec.ret.xts)
       attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
       colnames(attr.list[[k]]) <- c(factorNames, "specific.returns")
     }
-  }    
-  
-  if (class(fit)=="ffm" ) {
+  }
+
+  if (is(fit)=="ffm" ) {
     # if benchmark is provided
     #       if (!is.null(benchmark)) {
     #         stop("use fitFundamentalFactorModel instead")
@@ -118,7 +119,7 @@ paFm <- function(fit, ...) {
     factor.names <- colnames(fit$beta)
     date <- zoo::index(factor.returns)
     ticker <- fit$asset.names
-    
+
     #cumulative return attributed to factors
     if (factor.names[1] == "(Intercept)") {
       # discard intercept
@@ -130,26 +131,26 @@ paFm <- function(fit, ...) {
     }
     cum.spec.ret <- rep(0, length(ticker))
     names(cum.spec.ret) <- ticker
-    
-    # make list of every asstes and every list contains return attributed to 
+
+    # make list of every asstes and every list contains return attributed to
     # factors and specific returns
-    attr.list <- list() 
-    
+    attr.list <- list()
+
     for (k in ticker) {
       idx <- which(fit$data[, fit$assetvar]== k)
       returns <- fit$data[idx, fit$returnsvar]
-      num.f.names <- intersect(fit$exposure.names, factor.names) 
-      
+      num.f.names <- intersect(fit$exposure.names, factor.names)
+
       # check if there is industry factors
       if (length(setdiff(fit$exposure.names, factor.names)) > 0) {
-        ind.f <- matrix(rep(fit$beta[k, ][-(1:length(num.f.names))], 
+        ind.f <- matrix(rep(fit$beta[k, ][-(1:length(num.f.names))],
                             length(idx)), nrow=length(idx), byrow=TRUE)
         colnames(ind.f) <- colnames(fit$beta)[-(1:length(num.f.names))]
-        exposure <- cbind(fit$data[idx, num.f.names], ind.f) 
+        exposure <- cbind(fit$data[idx, num.f.names], ind.f)
       } else {
         exposure <- fit$data[idx, num.f.names]
       }
-      
+
       attr.factor <- exposure * coredata(factor.returns)
       specific.returns <- returns - apply(attr.factor, 1, sum)
       attr <- cbind(attr.factor, specific.returns)
@@ -158,9 +159,9 @@ paFm <- function(fit, ...) {
       cum.spec.ret[k] <- PerformanceAnalytics::Return.cumulative(specific.returns)
     }
   }
-  
-  if (class(fit)=="sfm") {
-    
+
+  if (is(fit)=="sfm") {
+
     # return attributed to factors
     cum.attr.ret <- fit$loadings
     cum.spec.ret <- fit$r2
@@ -170,33 +171,33 @@ paFm <- function(fit, ...) {
     # create list for attribution
     attr.list <- list()
     # pca method
-    
+
     if ( dim(fit$data)[1] > dim(fit$data)[2] ) {
-      
+
       for (k in fundNames) {
         fit.lm <- fit$asset.fit[[k]]
         ## extract information from lm object
         date <- zoo::index(data[,k])
         # probably needs more general Date setting
         actual.xts <- xts::xts(fit.lm$model[1], as.Date(date))
         # attributed returns
-        # active portfolio management p.512 17A.9 
+        # active portfolio management p.512 17A.9
         cum.ret <-   PerformanceAnalytics::Return.cumulative(actual.xts)
         # setup initial value
         attr.ret.xts.all <- xts::xts(, as.Date(date))
-        
+
         for (i in factorNames) {
-          attr.ret.xts <- actual.xts - 
-            xts::xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), 
-                as.Date(date))  
-          cum.attr.ret[k,i] <- cum.ret - 
-            PerformanceAnalytics::Return.cumulative(actual.xts - attr.ret.xts)  
+          attr.ret.xts <- actual.xts -
+            xts::xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]),
+                as.Date(date))
+          cum.attr.ret[k,i] <- cum.ret -
+            PerformanceAnalytics::Return.cumulative(actual.xts - attr.ret.xts)
           attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
         }
-        
-        # specific returns    
-        spec.ret.xts <- actual.xts - 
-          xts::xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]), 
+
+        # specific returns
+        spec.ret.xts <- actual.xts -
+          xts::xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]),
               as.Date(date))
         cum.spec.ret[k] <- cum.ret - PerformanceAnalytics::Return.cumulative(actual.xts- spec.ret.xts)
         attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
@@ -207,37 +208,37 @@ paFm <- function(fit, ...) {
       #   fit$loadings # N X K
       #   fit$factors  # T X K
       date <- zoo::index(fit$factors)
-      
+
       for (k in fundNames) {
         attr.ret.xts.all <- xts::xts(, as.Date(date))
         actual.xts <- xts::xts(fit$data[,k], as.Date(date))
         cum.ret <- PerformanceAnalytics::Return.cumulative(actual.xts)
-        
+
         for (i in factorNames) {
           attr.ret.xts <- xts::xts(fit$factors[,i]*fit$loadings[k,i], as.Date(date))
           attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
-          cum.attr.ret[k,i] <- cum.ret - PerformanceAnalytics::Return.cumulative(actual.xts - 
+          cum.attr.ret[k,i] <- cum.ret - PerformanceAnalytics::Return.cumulative(actual.xts -
                                                              attr.ret.xts)
         }
-        spec.ret.xts <- actual.xts - xts::xts(fit$factors%*%t(fit$loadings[k,]), 
+        spec.ret.xts <- actual.xts - xts::xts(fit$factors%*%t(fit$loadings[k,]),
                                          as.Date(date))
         cum.spec.ret[k] <- cum.ret - PerformanceAnalytics::Return.cumulative(actual.xts- spec.ret.xts)
         attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
-        colnames(attr.list[[k]]) <- c(factorNames, "specific.returns")  
+        colnames(attr.list[[k]]) <- c(factorNames, "specific.returns")
       }
-    } 
+    }
   }
-  
-  ans <- list(cum.ret.attr.f=cum.attr.ret, cum.spec.ret=cum.spec.ret, 
+
+  ans <- list(cum.ret.attr.f=cum.attr.ret, cum.spec.ret=cum.spec.ret,
               attr.list=attr.list)
-  class(ans) <- "pafm"      
+  class(ans) <- "pafm"
   return(ans)
 }
 
 
 # If benchmark is provided, active return attribution will be calculated.
-#  active returns = total returns  - benchmark returns. Specifically,  
-# \eqn{R_t^A = \sum_j b_{j}^A * f_{jt} + u_t^A},t=1..T, \eqn{b_{j}^A} is 
-# \emph{active exposure} to factor j and \eqn{f_{jt}} is factor j. The active 
-# returns attributed to factor j is \eqn{b_{j}^A * f_{jt}} specific returns is 
-# \eqn{u_t^A} 
+#  active returns = total returns  - benchmark returns. Specifically,
+# \eqn{R_t^A = \sum_j b_{j}^A * f_{jt} + u_t^A},t=1..T, \eqn{b_{j}^A} is
+# \emph{active exposure} to factor j and \eqn{f_{jt}} is factor j. The active
+# returns attributed to factor j is \eqn{b_{j}^A * f_{jt}} specific returns is
+# \eqn{u_t^A}