Fixed conflicts with inherit()

R/bspline.R

@@ -74,7 +74,7 @@ bspline <- function(X, Boundary.knots = NA, intercept = FALSE, df = NULL, knots
         Boundary.knots <- bknots
     }
     # If a list, then call on each element
-    if (inherits(X,"list")) {
+    if (inherits(X, "list")){
         # Call again for each element
         val <- lapply(1:length(X), function(i) {
             bspline(X[[i]], df = df, knots = knots, degree = degree, intercept = intercept, 

R/getse.R

@@ -70,14 +70,14 @@ getse <- function(L, inm = NA, depth = 2, useregex = FALSE, fun = NA) {
     if(depth == 1){
         if(useregex){ inm <- grep(inm, names(L)) }
         R <- L[[inm]]
-        if(class(fun) == "function"){ R <- fun(R) }
+        if(inherits(fun, "function")){ R <- fun(R) }
     }
     # Match in the subelements of L?
     if(depth == 2){
         R <- lapply(L, function(x){
             if(useregex){ inm <- grep(inm, names(x)) }
             val <- x[[inm]]
-            if(class(fun) == "function"){ val <- fun(val) }
+            if(inherits(fun, "function")){ val <- fun(val) }
             return(val)
         })
     }

R/lm_fit.R

@@ -130,7 +130,7 @@ lm_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE, pr
     #----------------------------------------------------------------
     # Calculate the result to return
     # If the objective function (scorefun) is given
-    if(class(scorefun) == "function"){
+    if(inherits(scorefun, "function")){
         # Do some checks
         if( !("scoreperiod" %in% names(data)) ){ stop("data$scoreperiod is not set: Must have it set to an index (int or logical) defining which points to be evaluated in the scorefun().") }
         if( all(is.na(data$scoreperiod)) ){ stop("data$scoreperiod is not set correctly: It must be set to an index (int or logical) defining which points to be evaluated in the scorefun().") }
@@ -156,39 +156,4 @@ lm_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE, pr
         return(val)
     }
 
-    ## OLD
-    ## # Is an objective function given?
-    ## if(class(scorefun) == "function" & !returnanalysis){
-    ##     # Do some checks
-    ##     if( !("scoreperiod" %in% names(data)) ){ stop("data$scoreperiod are set: Must have it set to an index (int or logical) defining which points to be evaluated in the scorefun().") }
-    ##     if( all(is.na(data$scoreperiod)) ){ stop("data$scoreperiod is not set correctly: It must be set to an index (int or logical) defining which points to be evaluated in the scorefun().") }
-    ##     scoreperiod <- data$scoreperiod    
-    ##     # Return the scorefun values
-    ##     scoreval <- sapply(1:ncol(Yhat), function(i){
-    ##         scorefun(Resid[scoreperiod,i])
-    ##     })
-    ##     nams(scoreval) <- nams(Yhat)
-    ##     val <- sum(scoreval, na.rm = TRUE)
-    ##     if(printout){print(c(scoreval,sum=val))}
-    ##     return(val)
-    ## } else if(returnanalysis){
-    ##     # The estimated coefficients
-    ##     Lfitval <- lapply(model$Lfits, function(model){ 
-    ##       coef <- model$coefficients
-    ##       names(coef) <- gsub("(.+?)(\\.k.*)", "\\1", names(coef))
-    ##       return(coef)
-    ##     })
-    ##     # Include score function
-    ##     scoreval <- NA
-    ##     if(class(scorefun) == "function"){
-    ##         # Calculate the objective function for each horizon
-    ##         scoreval <- sapply(1:ncol(Yhat), function(i){
-    ##             scorefun(Resid[,i])
-    ##         })
-    ##         nams(scoreval) <- nams(Yhat)
-    ##     }
-    ##     # Return the model validation data
-    ##     return(list(Yhat = Yhat, t = data$t, Resid = Resid, datatr = datatr, Lfitval = Lfitval, scoreval = scoreval, scoreperiod = data$scoreperiod))
-    ## }
-    ## invisible("ok")
 }

R/lp.R

@@ -37,7 +37,7 @@
 
 lp <- function(X, a1, usestate = TRUE) {
     ## 
-    if (class(X) == "list") {
+    if (inherits(X, "list")) {
         ## If only one coefficient, then repeat it
         if (length(a1) == 1) {
             a1 <- rep(a1, length(X))

R/rls_fit.R

@@ -183,7 +183,7 @@ rls_fit <- function(prm=NA, model, data, scorefun = NA, returnanalysis = TRUE,
     #----------------------------------------------------------------
     # Calculate the result to return
     # If the objective function (scorefun) is given
-    if(class(scorefun) == "function"){
+    if(inherits(scorefun, "function")){
         # Do some checks
         if( !("scoreperiod" %in% names(data)) ){ stop("data$scoreperiod is not set: Must have it set to an index (int or logical) defining which points to be evaluated in the scorefun().") }
         if( all(is.na(data$scoreperiod)) ){ stop("data$scoreperiod is not set correctly: It must be set to an index (int or logical) defining which points to be evaluated in the scorefun().") }

R/step_optim.R

@@ -240,7 +240,7 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back
         }
     }
     # Find the inputs to keep, if any
-    if(inherits(keepinputs,"logical")){
+    if(inherits(keepinputs, "logical")){
         if(keepinputs){
             keepinputs <- nams(mfull$inputs)
         }else{
@@ -266,7 +266,7 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back
             # Optimize
             res <- optimfun(m, data, printout=printout, scorefun=scorefun, ...)
             # Should we forecast only on the complete cases?
-            if(inherits(fitfun,"function")){
+            if(inherits(fitfun, "function")){
                 # Forecast to get the complete cases
                 mtmp <- m$clone_deep()
                 # If kseqopt is set, then make sure that it is used when fitting here
@@ -286,7 +286,7 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back
         }
         
         message("Current score: ",format(scoreCurrent,digits=7))
-        if(inherits(fitfun,"function")){
+        if(inherits(fitfun, "function")){
             message("Current complete cases: ",sum(casesCurrent)," (Diff in score from optim:",L[[istep]]$optimresult$value-scoreCurrent,")")
         }
         # Next step
@@ -382,7 +382,7 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back
             names(Lstep) <- names(mStep)
 
             # Complete cases considered: Should we forecast and recalculate the score on complete cases from all models?
-            if(inherits(fitfun,"function")){
+            if(inherits(fitfun, "function")){
                 LYhat <- mclapply(1:length(mStep), function(i){
                     mtmp <- mStep[[i]]$clone_deep()
                     # If kseqopt is set, then make sure that it is used when fitting here
@@ -409,7 +409,7 @@ step_optim <- function(modelfull, data, prm=list(NA), direction = c("both","back
                 tmp[ ,1] <- pst(format(100 * (scoreCurrent - tmp) / scoreCurrent, digits=2),"%")
                 nams(tmp) <- "Improvement"
             }
-            if(inherits(fitfun,"function")){
+            if(inherits(fitfun, "function")){
                 tmp <- cbind(tmp, apply(casesStep != casesCurrent, 2, sum))
                 nams(tmp)[2] <- "CasesDiff"
             }

src/RcppExports.cpp

@@ -6,6 +6,11 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
 // lp_vector_cpp
 NumericVector lp_vector_cpp(NumericVector x, double a1);
 RcppExport SEXP _onlineforecast_lp_vector_cpp(SEXP xSEXP, SEXP a1SEXP) {