Merge pull request #45 from m-muecke/equals

refactor: remove redundant comparison use more `isTRUE()` and `isFALSE`

Author: davidruegamer

R/baselearners.R

@@ -229,7 +229,7 @@ hyper_signal <- function(mf, vary, inS="smooth", knots = 10, boundary.knots = NU
   #     stop("variable names and knot names must be the same")
   #   if (is.list(boundary.knots)) if(!all(names(boundary.knots) %in% nm))
   #     stop("variable names and boundary.knot names must be the same")
-  if (!identical(center, FALSE) && cyclic)
+  if (!isFALSE(center) && cyclic)
     stop("centering of cyclic covariates not yet implemented")
   #    ret <- vector(mode = "list", length = length(nm))
   #    names(ret) <- nm
@@ -363,7 +363,7 @@ X_bsignal <- function(mf, vary, args) {
 
   #####################################################
   ####### K <- crossprod(K) has been computed before!
-  if (!identical(args$center, FALSE)) {
+  if (!isFALSE(args$center)) {
 
     ### L = \Gamma \Omega^1/2 in Section 2.3. of
     ### Fahrmeir et al. (2004, Stat Sinica); "spectralDecomp"
@@ -1102,7 +1102,7 @@ hyper_hist <- function(mf, vary, knots = 10, boundary.knots = NULL, degree = 3,
   #     stop("variable names and knot names must be the same")
   #   if (is.list(boundary.knots)) if(!all(names(boundary.knots) %in% nm))
   #     stop("variable names and boundary.knot names must be the same")
-  if (!identical(center, FALSE) && cyclic)
+  if (!isFALSE(center) && cyclic)
     stop("centering of cyclic covariates not yet implemented")
   #    ret <- vector(mode = "list", length = length(nm))
   #    names(ret) <- nm
@@ -1990,7 +1990,7 @@ X_bbsc <- function(mf, vary, args) {
     if (vary != "" && ncol(by) > 1){       # build block diagonal penalty
       suppressMessages(K <- kronecker(diag(ncol(by)), K))
     }
-    if (!identical(args$center, FALSE)) {
+    if (!isFALSE(args$center)) {
       ### L = \Gamma \Omega^1/2 in Section 2.3. of Fahrmeir et al.
       ### (2004, Stat Sinica), always
       L <- eigen(K, symmetric = TRUE)
@@ -2010,7 +2010,7 @@ X_bbsc <- function(mf, vary, args) {
   ### <SB> Calculate constraints
 
   ## for center = TRUE, design matrix does not contain constant part 
-  if(args$center != FALSE){ 
+  if(!isFALSE(args$center)){ 
 
     ## center the columns of the design matrix 
     ## Z contains column means

R/baselearnersX.R

@@ -32,7 +32,7 @@ hyper_histx <- function(mf, vary, knots = 10, boundary.knots = NULL, degree = 3,
     stop("variable names and knot names must be the same")
   if (is.list(boundary.knots)) if(!all(names(boundary.knots) %in% nm))
     stop("variable names and boundary.knot names must be the same")
-  if (!identical(center, FALSE) && cyclic)
+  if (!isFALSE(center) && cyclic)
     stop("centering of cyclic covariates not yet implemented")
   ret <- vector(mode = "list", length = length(nm))
   names(ret) <- nm

R/constrainedX.R

@@ -89,8 +89,8 @@
   if(any(used_bl == "bolsc")) stop("Use bols instead of bolsc with %Xc%.")
   if(any(used_bl == "brandomc")) stop("Use brandom instead of brandomc with %Xc%.")
   if(any(used_bl == "bbsc")) stop("Use bbs instead of bbsc with %Xc%.")
-  if( (!is.null(match.call()$bl1$intercept) &&  match.call()$bl1$intercept != TRUE) ||
-      (!is.null(match.call()$bl2$intercept) &&  match.call()$bl2$intercept != TRUE) ){
+  if( (!is.null(match.call()$bl1$intercept) && !isTRUE(match.call()$bl1$intercept)) ||
+      (!is.null(match.call()$bl2$intercept) && !isTRUE(match.call()$bl2$intercept)) ){
     stop("Set intercept = TRUE in base-learners used with %Xc%.")
   }
 

R/crossvalidation.R

@@ -800,7 +800,7 @@ validateFDboost <- function(object, response = NULL,
     # Using the offset of object with the following settings 
     # call$control <- boost_control(risk="oobag")
     # call$oobweights <- oobweights[id]
-    if(refitSmoothOffset == FALSE && is.null(call$offset) ){
+    if(!refitSmoothOffset && is.null(call$offset) ){
       if(!inherits(object, "FDboostLong")){
         call$offset <- matrix(object$offset, ncol = Gy)[1, ]
       }else{

R/methods.R

@@ -1050,7 +1050,7 @@ coef.FDboost <- function(object, raw = FALSE, which = NULL,
           if(!is.matrix(predHelp)){ 
             X <- predHelp
           }else{
-            X <- if(any(trm$get_names() %in% c("ONEtime")) ||
+            X <- if(any(trm$get_names() %in% "ONEtime") ||
                     inherits(object, "FDboostScalar")){ # effect constant in t 
               predHelp[,1]
             }else{