Skip to content

Commit 2595cbc

Browse files
m-mueckem-muecke
committed
refactor: replace 1:ncol(x) with safer seq_len(ncol(x)) 
1 parent c8d509c commit 2595cbc

7 files changed

Lines changed: 32 additions & 32 deletions

File tree

‎R/baselearners.R‎

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -273,7 +273,7 @@ X_bsignal <- function(mf, vary, args) {
273273
"linear" = matrix(c(rep(1, length(xind)), xind), ncol=2),
274274
"constant"= matrix(c(rep(1, length(xind))), ncol=1))
275275

276-
colnames(Bs) <- paste(xname, 1:ncol(Bs), sep="")
276+
colnames(Bs) <- paste(xname, seq_len(ncol(Bs)), sep="")
277277

278278

279279
# use cyclic splines
@@ -288,7 +288,7 @@ X_bsignal <- function(mf, vary, args) {
288288
fun = "cbs")
289289
}
290290

291-
colnames(Bs) <- paste(xname, 1:ncol(Bs), sep="")
291+
colnames(Bs) <- paste(xname, seq_len(ncol(Bs)), sep="")
292292

293293
### Penalty matrix: product differences matrix
294294
if (args$differences > 0){
@@ -343,7 +343,7 @@ X_bsignal <- function(mf, vary, args) {
343343
# Design matrix is product of weighted X1 and basis expansion over xind
344344
X <- (L*X1) %*% Bs
345345

346-
colnames(X) <- paste0(xname, 1:ncol(X))
346+
colnames(X) <- paste0(xname, seq_len(ncol(X)))
347347

348348
## see Scheipl and Greven (2016):
349349
## Identifiability in penalized function-on-function regression models
@@ -680,14 +680,14 @@ bsignal <- function(x, s, index = NULL, inS = c("smooth", "linear", "constant"),
680680

681681
varnames <- all.vars(cll)
682682
# if(length(mfL)==1){
683-
# mfL[[2]] <- 1:ncol(mfL[[1]]); cll[[3]] <- "xind"
683+
# mfL[[2]] <- seq_len(ncol(mfL[[1]])); cll[[3]] <- "xind"
684684
# varnames <- c(all.vars(cll), "xindDefault")
685685
# }
686686

687687
# Reshape mfL so that it is the dataframe of the signal with the index as attribute
688688
xname <- varnames[1]
689689
indname <- varnames[2]
690-
if(is.null(colnames(x))) colnames(x) <- paste(xname, 1:ncol(x), sep="_")
690+
if(is.null(colnames(x))) colnames(x) <- paste(xname, seq_len(ncol(x)), sep="_")
691691
attr(x, "signalIndex") <- s
692692
attr(x, "xname") <- xname
693693
attr(x, "indname") <- indname
@@ -870,12 +870,12 @@ X_conc <- function(mf, vary, args) {
870870
fun = "cbs")
871871
}
872872

873-
colnames(Bs) <- paste(xname, 1:ncol(Bs), sep="")
873+
colnames(Bs) <- paste(xname, seq_len(ncol(Bs)), sep="")
874874

875875
# set up design matrix for concurrent model
876876
if(args$format=="wide"){
877877
listCol <- list()
878-
for(i in 1:ncol(X1)){
878+
for(i in seq_len(ncol(X1))){
879879
listCol[[i]] <- X1[,i]
880880
}
881881
X1des <- as.matrix(bdiag(listCol))
@@ -958,7 +958,7 @@ bconcurrent <- function(x, s, time, index = NULL, #by = NULL,
958958
attr(x, "id") <- index
959959

960960
if(mboost_intern(x, fun = "isMATRIX") &&
961-
is.null(colnames(x))) colnames(x) <- paste(xname, 1:ncol(x), sep="_")
961+
is.null(colnames(x))) colnames(x) <- paste(xname, seq_len(ncol(x)), sep="_")
962962
attr(x, "signalIndex") <- s
963963
attr(x, "xname") <- xname
964964
attr(x, "indname") <- indname
@@ -1176,7 +1176,7 @@ X_hist <- function(mf, vary, args) {
11761176
"linear" = matrix(c(rep(1, length(xind)), xind), ncol = 2),
11771177
"constant"= matrix(c(rep(1, length(xind))), ncol = 1))
11781178

1179-
colnames(Bs) <- paste(xname, 1:ncol(Bs), sep="")
1179+
colnames(Bs) <- paste(xname, seq_len(ncol(Bs)), sep="")
11801180

11811181
# integration weights
11821182
L <- args$intFun(X1=X1, xind=xind)
@@ -1188,7 +1188,7 @@ X_hist <- function(mf, vary, args) {
11881188
# # set up design matrix for historical model and s<=t with s and t equal to xind
11891189
# # expand matrix of original observations to lower triangular matrix
11901190
# X1des0 <- matrix(0, ncol=ncol(X1), nrow=ncol(X1)*nrow(X1))
1191-
# for(i in 1:ncol(X1des0)){
1191+
# for(i in seq_len(ncol(X1des0))){
11921192
# #print(nrow(X1)*(i-1)+1)
11931193
# X1des0[(nrow(X1)*(i-1)+1):nrow(X1des0) ,i] <- X1[,i] # use fun. variable * integration weights
11941194
# }
@@ -1368,11 +1368,11 @@ X_hist <- function(mf, vary, args) {
13681368
# calculate row-tensor
13691369
# X <- (X1 %x% t(rep(1, ncol(X2))) ) * ( t(rep(1, ncol(X1))) %x% X2 )
13701370
dimnames(Bt) <- NULL # otherwise warning "dimnames [2] mismatch..."
1371-
X <- X1des[,rep(1:ncol(Bs), each=ncol(Bt))] * Bt[,rep(1:ncol(Bt), times=ncol(Bs))]
1371+
X <- X1des[, rep(seq_len(ncol(Bs)), each=ncol(Bt))] * Bt[, rep(seq_len(ncol(Bt)), times=ncol(Bs))]
13721372

13731373
if(! mboost_intern(X, fun = "isMATRIX") ) X <- matrix(X, ncol=1)
13741374

1375-
colnames(X) <- paste0(xname, 1:ncol(X))
1375+
colnames(X) <- paste0(xname, seq_len(ncol(X)))
13761376

13771377
### Penalty matrix: product differences matrix for smooth effect
13781378
if(args$inS == "smooth"){
@@ -1483,7 +1483,7 @@ bhist <- function(x, s, time, index = NULL, #by = NULL,
14831483
indname <- varnames[2]
14841484
indnameY <- varnames[3]
14851485
if(length(varnames)==2) indnameY <- varnames[2]
1486-
if(is.null(colnames(x))) colnames(x) <- paste(xname, 1:ncol(x), sep="_")
1486+
if(is.null(colnames(x))) colnames(x) <- paste(xname, seq_len(ncol(x)), sep="_")
14871487
attr(x, "signalIndex") <- s
14881488
attr(x, "xname") <- xname
14891489
attr(x, "indname") <- indname
@@ -1689,7 +1689,7 @@ X_fpc <- function(mf, vary, args) {
16891689
##stop("In bfpc the grid for the functional covariate has to be the same as in the model fit!")
16901690
## linear interpolation of the basis functions
16911691
approxEfunctions <- matrix(NA, nrow=length(xind), ncol=length(args$subset))
1692-
for(i in 1:ncol(klX$efunctions[ , args$subset, drop = FALSE])){
1692+
for(i in seq_len(ncol(klX$efunctions[, args$subset, drop = FALSE]))){
16931693
approxEfunctions[,i] <- approx(x=args$klX$xind, y=klX$efunctions[,i], xout=xind)$y
16941694
}
16951695
approxMu <- approx(x=args$klX$xind, y=klX$mu, xout=xind)$y
@@ -1700,7 +1700,7 @@ X_fpc <- function(mf, vary, args) {
17001700

17011701
}
17021702

1703-
colnames(X) <- paste(xname, ".PC", 1:ncol(X), sep = "")
1703+
colnames(X) <- paste(xname, ".PC", seq_len(ncol(X)), sep = "")
17041704

17051705
## set up the penalty matrix
17061706
K <- switch(args$penalty,
@@ -1747,7 +1747,7 @@ bfpc <- function(x, s, index = NULL, df = 4,
17471747
# Reshape mfL so that it is the dataframe of the signal with the index as attribute
17481748
xname <- varnames[1]
17491749
indname <- varnames[2]
1750-
if(is.null(colnames(x))) colnames(x) <- paste(xname, 1:ncol(x), sep="_")
1750+
if(is.null(colnames(x))) colnames(x) <- paste(xname, seq_len(ncol(x)), sep="_")
17511751
attr(x, "signalIndex") <- s
17521752
attr(x, "xname") <- xname
17531753
attr(x, "indname") <- indname
@@ -1879,7 +1879,7 @@ X_bbsc <- function(mf, vary, args) {
18791879
if (vary != "") {
18801880
by <- model.matrix(as.formula(paste("~", vary, collapse = "")),
18811881
data = mf)[ , -1, drop = FALSE] # drop intercept
1882-
DM <- lapply(1:ncol(by), function(i) {
1882+
DM <- lapply(seq_len(ncol(by)), function(i) {
18831883
ret <- X * by[, i]
18841884
colnames(ret) <- paste(colnames(ret), colnames(by)[i], sep = ":")
18851885
ret
@@ -2386,7 +2386,7 @@ X_olsc <- function(mf, vary, args) {
23862386
if (vary != "") {
23872387
by <- model.matrix(as.formula(paste("~", vary, collapse = "")),
23882388
data = mf)[ , -1, drop = FALSE] # drop intercept
2389-
DM <- lapply(1:ncol(by), function(i) {
2389+
DM <- lapply(seq_len(ncol(by)), function(i) {
23902390
ret <- X * by[, i]
23912391
colnames(ret) <- paste(colnames(ret), colnames(by)[i], sep = ":")
23922392
ret

‎R/baselearnersX.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -92,7 +92,7 @@ X_histx <- function(mf, vary, args) {
9292
"linear" = matrix(c(rep(1, length(xind)), xind), ncol = 2),
9393
"constant"= matrix(c(rep(1, length(xind))), ncol = 1))
9494

95-
colnames(Bs) <- paste(xname, 1:ncol(Bs), sep="")
95+
colnames(Bs) <- paste(xname, seq_len(ncol(Bs)), sep="")
9696

9797
# integration weights
9898
L <- args$intFun(X1=X1, xind=xind)
@@ -234,11 +234,11 @@ X_histx <- function(mf, vary, args) {
234234
# calculate row-tensor
235235
# X <- (X1 %x% t(rep(1, ncol(X2))) ) * ( t(rep(1, ncol(X1))) %x% X2 )
236236
dimnames(Bt) <- NULL # otherwise warning "dimnames [2] mismatch..."
237-
X <- X1des[,rep(1:ncol(Bs), each=ncol(Bt))] * Bt[,rep(1:ncol(Bt), times=ncol(Bs))]
237+
X <- X1des[, rep(seq_len(ncol(Bs)), each=ncol(Bt))] * Bt[, rep(seq_len(ncol(Bt)), times=ncol(Bs))]
238238

239239
if(! mboost_intern(X, fun = "isMATRIX") ) X <- matrix(X, ncol=1)
240240

241-
colnames(X) <- paste0(xname, 1:ncol(X))
241+
colnames(X) <- paste0(xname, seq_len(ncol(X)))
242242

243243
### Penalty matrix: product differences matrix for smooth effect
244244
if(args$inS == "smooth"){

‎R/crossvalidation.R‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -506,14 +506,14 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
506506
OOBweights[folds > 0] <- 0
507507

508508
if (isTRUE(all.equal(papply, mclapply))) {
509-
oobrisk <- papply(1:ncol(folds),
509+
oobrisk <- papply(seq_len(ncol(folds)),
510510
function(i) try(dummyfct(weights = folds[, i],
511511
oobweights = OOBweights[, i]),
512512
silent = TRUE),
513513
mc.preschedule = mc.preschedule,
514514
...)
515515
} else {
516-
oobrisk <- papply(1:ncol(folds),
516+
oobrisk <- papply(seq_len(ncol(folds)),
517517
function(i) try(dummyfct(weights = folds[, i],
518518
oobweights = OOBweights[, i]),
519519
silent = TRUE),
@@ -895,11 +895,11 @@ validateFDboost <- function(object, response = NULL,
895895

896896
### computation of models on partitions of data
897897
if(Sys.info()["sysname"]=="Linux"){
898-
modRisk <- mclapply(1:ncol(folds),
898+
modRisk <- mclapply(seq_len(ncol(folds)),
899899
function(i) dummyfct(weights = folds[, i],
900900
oobweights = OOBweights[, i]), ...)
901901
}else{
902-
modRisk <- mclapply(1:ncol(folds),
902+
modRisk <- mclapply(seq_len(ncol(folds)),
903903
function(i) dummyfct(weights = folds[, i],
904904
oobweights = OOBweights[, i]), mc.cores = 1)
905905
}

‎R/hmatrix.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
#' @param id specify to which curve the point belongs to, id from 1, 2, ..., n.
1616
#' @param x matrix of functional covariate, each trajectory is in one row
1717
#' @param argvals set of argument values, i.e., the common gird at which the functional covariate
18-
#' is observed, by default \code{1:ncol(x)}
18+
#' is observed, by default \code{seq_len(ncol(x))}
1919
#' @param timeLab name of the time axis, by default \code{t}
2020
#' @param idLab name of the id variable, by default \code{wideIndex}
2121
#' @param xLab name of the functional variable, by default NULL
@@ -70,7 +70,7 @@
7070
#' @return An matrix object of type \code{"hmatrix"}
7171
#'
7272
#' @export
73-
hmatrix <- function(time, id, x, argvals=1:ncol(x),
73+
hmatrix <- function(time, id, x, argvals=seq_len(ncol(x)),
7474
timeLab="t", idLab="wideIndex", xLab="x", argvalsLab="s"){
7575

7676
## check that id is integer valued containing 1, 2, 3, ..., n

‎R/methods.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1691,7 +1691,7 @@ plot.FDboost <- function(x, raw = FALSE, rug = TRUE, which = NULL,
16911691
# convert matrix into a list, each list entry for one effect
16921692
if(is.null(x$ydim) & !is.null(dim(terms))){
16931693
temp <- list()
1694-
for(i in 1:ncol(terms)){
1694+
for(i in seq_len(ncol(terms))){
16951695
temp[[i]] <- terms[,i]
16961696
}
16971697
names(temp) <- colnames(terms)

‎R/utilityFunctions.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -752,7 +752,7 @@ check_ident <- function(X1, L, Bs, K, xname, penalty,
752752
logCondDs_hist[k] <- log10(max(evDs)) - log10(min(evDs))
753753
}
754754
## matplot(xind, Bs, type="l", lwd=2, ylim=c(-2,2)); rug(xind); rug(yind, col=2, lwd=2)
755-
## matplot(knots[1:ncol(Ds_t)], t(Ds_t), type="l", lwd=1, add=TRUE)
755+
## matplot(knots[seq_len(ncol(Ds_t))], t(Ds_t), type="l", lwd=1, add=TRUE)
756756
## lines(t_unique, logCondDs_hist-6, col=2, lwd=4)
757757
}
758758
names(logCondDs_hist) <- round(t_unique,2)
@@ -836,11 +836,11 @@ check_ident <- function(X1, L, Bs, K, xname, penalty,
836836
overlapKe <- max(cumOverlapKe, na.rm = TRUE) #cumOverlapKe[[length(cumOverlapKe)]]
837837

838838
}else{ # overlap between whole matrix X and penalty
839-
overlapKe <- getOverlap(subset=1:ncol(X1), X1=X1, L=L, Bs=Bs, K=K)
839+
overlapKe <- getOverlap(subset=seq_len(ncol(X1)), X1=X1, L=L, Bs=Bs, K=K)
840840
}
841841

842842
# look at overlap with whole functional covariate
843-
overlapKeComplete <- getOverlap(subset=1:ncol(X1), X1=X1, L=L, Bs=Bs, K=K)
843+
overlapKeComplete <- getOverlap(subset=seq_len(ncol(X1)), X1=X1, L=L, Bs=Bs, K=K)
844844

845845
if(giveWarnings & overlapKe >= 1){
846846
warning("Kernel overlap for <", xname, "> and the specified basis and penalty detected. ",

‎tests/factorize_test_regular.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,7 @@ par(opar)
8989
# re-compose prediction
9090
preds <- lapply(fac, predict)
9191
PREDSf <- array(0, dim = c(nrow(preds$resp),nrow(preds$cov)))
92-
for(i in 1:ncol(preds$resp))
92+
for(i in seq_len(ncol(preds$resp)))
9393
PREDSf <- PREDSf + preds$resp[,i] %*% t(preds$cov[,i])
9494

9595
opar <- par(mfrow = c(1,2))

0 commit comments

Comments
 (0)