diff --git a/R/bspline.R b/R/bspline.R
index c7f473fe93052278200ebddedf600f53bb76ebfc..25fe2b9132ff8dfc0e0383f2a99a31770ba747d6 100644
--- a/R/bspline.R
+++ b/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,
diff --git a/R/getse.R b/R/getse.R
index 9cfdaa32e9875fa7dc476318820556fa51bd78cd..a82a9c020e4b890e75594e7c45e994fe651bd3d5 100644
--- a/R/getse.R
+++ b/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)
})
}
diff --git a/R/lm_fit.R b/R/lm_fit.R
index 26ff23742c4ea14351d343d4688b1a6d5eff46e1..7a6727699db9f7991d34904a8d0cf6e2739587e3 100644
--- a/R/lm_fit.R
+++ b/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")
}
diff --git a/R/lp.R b/R/lp.R
index b1178615cfb9cf4f1eb7fce00d35d8c377cea494..f9408ebeb63010d1e52a5668420a50a3f0ac5c63 100644
--- a/R/lp.R
+++ b/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))
diff --git a/R/rls_fit.R b/R/rls_fit.R
index d017a0d9eaff18e4c7045861b17c98f4dc7e115f..10b5df416cc6d5a88df066e704811011568fb0dc 100644
--- a/R/rls_fit.R
+++ b/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().") }
diff --git a/R/step_optim.R b/R/step_optim.R
index 381dbfbc81d52f19e5fe95831ae84188175fe219..0cd8ed8201fd72d24d1d3ce56280ac70b27b7275 100644
--- a/R/step_optim.R
+++ b/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"
}
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
index a76e06a6f3328f42e085114d4d5eb5f0996e8fc8..20e61f5a6db5a3c3525e52ed4f7bbe15ba0aba45 100644
--- a/src/RcppExports.cpp
+++ b/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) {