refactor: replace 1:nrow(x) with safer seq_len(nrow(x))

Author: m-muecke

R/FDboost.R

@@ -1188,7 +1188,7 @@ FDboost <- function(formula,          ### response ~ xvars
   ## generate an id-variable for a regular response
   if(is.null(id)){
     if(scalarResponse){
-      id <- 1:NROW(response)
+      id <- seq_len(NROW(response))
     }else{
       id <- rep(1:ydim[1], times = ydim[2])
     }

R/baselearners.R

@@ -125,7 +125,7 @@ integrationWeights <- function(X1, xind, id = NULL){
 
   # taking into account missing values
   if(anyNA(X1)){
-    Lneu <- sapply(1:nrow(X1), function(i){
+    Lneu <- sapply(seq_len(nrow(X1)), function(i){
       x <- X1[i,]
 
       if(!anyNA(x)){
@@ -840,7 +840,7 @@ X_conc <- function(mf, vary, args) {
 
   ## <FIXME> is that line still necessary? 
   ## important for prediction, otherwise id=NULL and yind is multiplied accordingly
-  if(is.null(id)) id <- 1:nrow(X1)
+  if(is.null(id)) id <- seq_len(nrow(X1))
 
   ## check yind 
   if(args$format=="long" && length(yind)!=length(id)) stop(xname, ": Index of response and id do not have the same length")
@@ -1156,7 +1156,7 @@ X_hist <- function(mf, vary, args) {
   ## <FIXME> is that line still necessary? should it be there in long and wide format?
   ###### EXTRA LINE in comparison to X_hist
   ## important for prediction, otherwise id=NULL and yind is multiplied accordingly
-  if(is.null(id)) id <- 1:nrow(X1)
+  if(is.null(id)) id <- seq_len(nrow(X1))
 
   ## check yind 
   if(args$format=="long" && length(yind)!=length(id)) stop(xname, ": Index of response and id do not have the same length")
@@ -2519,9 +2519,9 @@ bolsc <- function(..., by = NULL, index = NULL, intercept = TRUE, df = NULL,
   if(is.null(index)){
 
     if(is.null(weights)){ ## use weights 
-      w <- 1:nrow(mf)
+      w <- seq_len(nrow(mf))
     }else{
-      w <- rep(1:nrow(mf), weights)
+      w <- rep(seq_len(nrow(mf)), weights)
     }
 
     temp <- X_olsc(mf[w, , drop = FALSE], vary, 
@@ -2531,9 +2531,9 @@ bolsc <- function(..., by = NULL, index = NULL, intercept = TRUE, df = NULL,
   }else{
 
     if(is.null(weights)){  ## use weights
-      w <- 1:nrow(mf[index, , drop = FALSE])
+      w <- seq_len(nrow(mf[index, , drop = FALSE]))
     }else{
-      w <- rep(1:nrow(mf[index, , drop = FALSE]), weights)
+      w <- rep(seq_len(nrow(mf[index, , drop = FALSE])), weights)
     }
 
     temp <- X_olsc(mf = (mf[index, , drop = FALSE])[w, , drop = FALSE], vary = vary, 

R/bootstrapCIs.R

@@ -404,7 +404,7 @@ bootstrapCI <- function(object, which = NULL,
     lapply(listOfQuantiles[isSurface], 
            function(x){ 
 
-             retL <- lapply(1:nrow(x), function(i) 
+             retL <- lapply(seq_len(nrow(x)), function(i) 
                matrix(x[i,], nrow = length(attr(x, "y"))))
              names(retL) <- levels
              return(retL)

R/constrainedX.R

@@ -104,8 +104,8 @@
                mboost_intern(bl2, fun = "model.frame.blg") )
   index1 <- bl1$get_index()
   index2 <- bl2$get_index()
-  if (is.null(index1)) index1 <- 1:nrow(mf)
-  if (is.null(index2)) index2 <- 1:nrow(mf)
+  if (is.null(index1)) index1 <- seq_len(nrow(mf))
+  if (is.null(index2)) index2 <- seq_len(nrow(mf))
 
   mfindex <- cbind(index1, index2)
   index <- NULL
@@ -312,8 +312,8 @@ bl_lin_matrix_a <- function(blg, Xfun, args) {
         # K2 <- args$K2 
 
         #  ## per default do not expand the marginal design matrices 
-        #  expand_index1 <- 1:nrow(X$X1)
-        #  expand_index2 <- 1:nrow(X$X2)
+        #  expand_index1 <- seq_len(nrow(X$X1))
+        #  expand_index2 <- seq_len(nrow(X$X2))
 
         ## weights-matrix W: weights are for single observations in the matrix Y
         ## but the marginal bl work either on columns or rows of Y 
@@ -375,8 +375,8 @@ bl_lin_matrix_a <- function(blg, Xfun, args) {
           ### but: this does not work correctly: problem with factor remains 
           #   ## W cannot be computed from w1 and w2, 
           #   ## -> blow up the marginal design matrices and use W with them, 
-          #   expand_index1 <- rep(1:nrow(X$X1), times = nrow(X$X2)) 
-          #   expand_index2 <- rep(1:nrow(X$X2), each = nrow(X$X1))  
+          #   expand_index1 <- rep(seq_len(nrow(X$X1)), times = nrow(X$X2)) 
+          #   expand_index2 <- rep(seq_len(nrow(X$X2)), each = nrow(X$X1))  
           #   ## all( c(W) == weights) is TRUE, ordering of weights must match to blown-up marginal design matrices 
           #   ## standardize weights to compensate for the blow-up of the marginal design-matrices  
           #   #w1 <- c(W) / mean(rowSums(W)) ## for some special cases (e.g. BS on rows): mean(rowSums(W)) == nrow(X$X2)
@@ -986,8 +986,8 @@ NULL
 
   index1 <- bl1$get_index()
   index2 <- bl2$get_index()
-  if (is.null(index1)) index1 <- 1:nrow(mf)
-  if (is.null(index2)) index2 <- 1:nrow(mf)
+  if (is.null(index1)) index1 <- seq_len(nrow(mf))
+  if (is.null(index2)) index2 <- seq_len(nrow(mf))
 
   mfindex <- cbind(index1, index2)
   index <- NULL

R/crossvalidation.R

@@ -135,7 +135,7 @@
 #'   cvr <- applyFolds(mod, folds = folds_bs, grid = 1:75)
 #' 
 #'   ## weights per observation point  
-#'   folds_bs_long <- folds_bs[rep(1:nrow(folds_bs), times = mod$ydim[2]), ]
+#'   folds_bs_long <- folds_bs[rep(seq_len(nrow(folds_bs)), times = mod$ydim[2]), ]
 #'   attr(folds_bs_long, "type") <- "3-fold bootstrap"
 #'   ## compute out-of-bag risk on the 3 folds for 1 to 75 boosting iterations  
 #'   cvr3 <- cvrisk(mod, folds = folds_bs_long, grid = 1:75)
@@ -541,7 +541,7 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
   oobrisk <- t(as.data.frame(oobrisk))
   ## oobrisk <- oobrisk  / colSums(OOBweights[object$id, ]) # is done in dummyfct() 
   colnames(oobrisk) <- grid
-  rownames(oobrisk) <- 1:nrow(oobrisk)
+  rownames(oobrisk) <- seq_len(nrow(oobrisk))
   attr(oobrisk, "risk") <- fam_name
   attr(oobrisk, "call") <- call
   attr(oobrisk, "mstop") <- grid
@@ -656,7 +656,7 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
 #'   cvr2 <- validateFDboost(mod, folds = folds_bs, grid = 1:75)
 #' 
 #'   ## weights per observation point  
-#'   folds_bs_long <- folds_bs[rep(1:nrow(folds_bs), times = mod$ydim[2]), ]
+#'   folds_bs_long <- folds_bs[rep(seq_len(nrow(folds_bs)), times = mod$ydim[2]), ]
 #'   attr(folds_bs_long, "type") <- "3-fold bootstrap"
 #'   ## compute out-of-bag risk on the 3 folds for 1 to 75 boosting iterations  
 #'   cvr3 <- cvrisk(mod, folds = folds_bs_long, grid = 1:75)
@@ -1739,7 +1739,7 @@ cvMa <- function(ydim, weights = rep(1, l = ydim[1] * ydim[2]),
   if ( (nrowY * ncolY) != n) stop("The arguments weights and ydim do not match.")
 
   ## cvMa is only a wrapper for cvLong
-  foldsMa <- cvLong(id = rep(1:nrowY, times = ncolY), weights = weights, 
+  foldsMa <- cvLong(id = rep(seq_len(nrowY), times = ncolY), weights = weights, 
                     type = type, B=B, prob = 0.5, strata = NULL) 
   return(foldsMa)
 }

R/hmatrix.R

@@ -57,7 +57,7 @@
 #' # ids and times in the time id matrix 
 #' # for bhistx baselearner, there may be an additional id variable for the tensor product
 #' newdat <- reweightData(data = list(hmat = myhmatrix, 
-#'   repIDx = rep(1:nrow(attr(myhmatrix,'x')), length(attr(myhmatrix,"argvals")))), 
+#'   repIDx = rep(seq_len(nrow(attr(myhmatrix,'x'))), length(attr(myhmatrix,"argvals")))), 
 #'   vars = "hmat", index = c(1,1,2), idvars="repIDx")
 #' length(newdat$repIDx) 
 #' 
@@ -75,7 +75,7 @@ hmatrix <- function(time, id, x, argvals=seq_len(ncol(x)),
 
   ## check that id is integer valued containing 1, 2, 3, ..., n 
   ## and that x has n rows
-  stopifnot( all(sort(unique(id)) == 1:nrow(x)) )  
+  stopifnot( all(sort(unique(id)) == seq_len(nrow(x))) )  
   stopifnot(length(time)==length(id))
 
   # convert x to a matrix, especially if x is of class AsIs

R/methods.R

@@ -1189,19 +1189,19 @@ coef.FDboost <- function(object, raw = FALSE, which = NULL,
         #print(attr(d, "varnms"))
         vari <- names(d)[1]
         if(is.factor(d[[vari]])){
-          d[[vari]] <- d[[vari]][ rep(1:NROW(d[[vari]]), times=length(d[[attr(object$yind ,"nameyind")]]) ) ]
+          d[[vari]] <- d[[vari]][ rep(seq_len(NROW(d[[vari]])), times=length(d[[attr(object$yind ,"nameyind")]]) ) ]
           if(trm$dim>1) d[[attr(object$yind ,"nameyind")]] <- rep(d[[attr(object$yind ,"nameyind")]], 
                                                                   each=length(unique(d[[vari]]))  )
           }else{
           # expand signal variable
           if( grepl("bhist(", trm$get_call(), fixed = TRUE) | 
               grepl("bsignal", trm$get_call()) | grepl("bfpc", trm$get_call()) ){
             vari <- names(d)[!names(d) %in% attr(d, "varnms")]
-            d[[vari]] <- d[[vari]][ rep(1:NROW(d[[vari]]), times=NROW(d[[vari]])), ]
+            d[[vari]] <- d[[vari]][ rep(seq_len(NROW(d[[vari]])), times=NROW(d[[vari]])), ]
 
           }else{ # expand scalar variable
             vari <- names(d)[1]
-            if(vari!=attr(object$yind ,"nameyind")) d[[vari]] <- d[[vari]][ rep(1:NROW(d[[vari]]), times=NROW(d[[vari]])) ]
+            if(vari!=attr(object$yind ,"nameyind")) d[[vari]] <- d[[vari]][ rep(seq_len(NROW(d[[vari]])), times=NROW(d[[vari]])) ]
           } 
           # expand yind 
           if(trm$dim>1) d[[attr(object$yind ,"nameyind")]] <- rep(d[[attr(object$yind ,"nameyind")]],