Skip to content

Commit c8d509c

Browse files
davidruegamerdavidruegamer
authored
Merge pull request #32 from m-muecke/seq-along
refactor: use more `seq_along(x)` instead of `1:length(x)`
2 parents d82e1d8 + b39e4ab commit c8d509c

11 files changed

Lines changed: 84 additions & 84 deletions

‎R/FDboost.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -463,7 +463,7 @@ FDboost <- function(formula, ### response ~ xvars
463463
## insert id at end of each base-learner
464464
trmstrings2 <- paste(substr(trmstrings, 1 , nchar(trmstrings)-1), ", index=", id[2],")", sep = "")
465465
## check if number of opening brackets is equal to number of closing brackets
466-
equalBrackets <- sapply(1:length(trmstrings2), function(i)
466+
equalBrackets <- sapply(seq_along(trmstrings2), function(i)
467467
{
468468
sapply(regmatches(trmstrings2[i], gregexpr("\\(", trmstrings2[i])), length) ==
469469
sapply(regmatches(trmstrings2[i], gregexpr("\\)", trmstrings2[i])), length)
@@ -485,7 +485,7 @@ FDboost <- function(formula, ### response ~ xvars
485485
##equalBrackets <- NULL
486486
if(length(trmstrings) > 0){
487487
## insert index into the other base-learners of the tensor-product as well
488-
for(i in 1:length(trmstrings)){
488+
for(i in seq_along(trmstrings)){
489489
if(grepl( "%X", trmstrings2[i])){
490490
temp <- unlist(strsplit(trmstrings2[i], "%X"))
491491
temp1 <- temp[-length(temp)]
@@ -637,7 +637,7 @@ FDboost <- function(formula, ### response ~ xvars
637637
stopifnot(length(response) == length(time) & length(response) == length(id))
638638

639639
if(anyNA(response)) warning("For non-grid observations the response should not contain missing values.")
640-
if( !all(sort(unique(id)) == 1:length(unique(id))) ) stop("id has to be integers 1, 2, 3,..., N.")
640+
if( !all(sort(unique(id)) == seq_along(unique(id))) ) stop("id has to be integers 1, 2, 3,..., N.")
641641

642642
nr <- length(response) # total number of observations
643643
nc <- length(unique(id)) # number of trajectories
@@ -683,7 +683,7 @@ FDboost <- function(formula, ### response ~ xvars
683683

684684
## check that the timevariable in timeformula and in the bhistx-base-learners have the same name
685685
if(any(grepl("bhistx", trmstrings))){
686-
for(j in 1:length(trmstrings)){
686+
for(j in seq_along(trmstrings)){
687687
if(any(grepl("bhistx", trmstrings[j]))){
688688
if(grepl("%X", trmstrings[j]) ){
689689
temp <- strsplit(trmstrings[[j]], "%X.*%")[[1]]
@@ -781,7 +781,7 @@ FDboost <- function(formula, ### response ~ xvars
781781
get_df <- function(bl){
782782
split_bl <- unlist(strsplit(bl, split = "%.{1,3}%"))
783783
all_df <- c()
784-
for(i in 1:length(split_bl)){
784+
for(i in seq_along(split_bl)){
785785
parti <- parse(text = split_bl[i])[[1]]
786786
parti <- expand.call(definition = get(as.character(parti[[1]])), call = parti)
787787
dfi <- parti$df # df of part i in bl
@@ -1166,7 +1166,7 @@ FDboost <- function(formula, ### response ~ xvars
11661166
if(any( gsub(" ", "", strsplit(cfm[2], "\\+")[[1]]) == "1")){
11671167
effectsToCheck <- 2:length(ret$baselearner)
11681168
}else{
1169-
effectsToCheck <- 1:length(ret$baselearner)
1169+
effectsToCheck <- seq_along(ret$baselearner)
11701170
}
11711171
# predict each effect separately
11721172
pred <- predict(ret, which = effectsToCheck)

‎R/baselearners.R‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -759,7 +759,7 @@ bsignal <- function(x, s, index = NULL, inS = c("smooth", "linear", "constant"),
759759
if(length(value) != names(mf[1]))
760760
stop(sQuote("value"), " must have same length as ",
761761
sQuote("names(mf[1])"))
762-
for (i in 1:length(value)){
762+
for (i in seq_along(value)){
763763
cll[[i+1]] <<- as.name(value[i])
764764
}
765765
attr(mf, "names") <<- value
@@ -1042,7 +1042,7 @@ bconcurrent <- function(x, s, time, index = NULL, #by = NULL,
10421042
if(length(value) != names(mf[1]))
10431043
stop(sQuote("value"), " must have same length as ",
10441044
sQuote("names(mf[1])"))
1045-
for (i in 1:length(value)){
1045+
for (i in seq_along(value)){
10461046
cll[[i+1]] <<- as.name(value[i])
10471047
}
10481048
attr(mf, "names") <<- value
@@ -1254,7 +1254,7 @@ X_hist <- function(mf, vary, args) {
12541254
# tempj <- unlist(apply(!ind0, 1, which)) # in which columns are the values?
12551255
# ## i: row numbers: one row number per observation of response,
12561256
# # repeat the row number for each entry
1257-
# X1des <- sparseMatrix(i=rep(1:length(id), times=rowSums(!ind0)), j=tempj,
1257+
# X1des <- sparseMatrix(i=rep(seq_along(id), times=rowSums(!ind0)), j=tempj,
12581258
# x=X1[cbind(rep(id, t=rowSums(!ind0)), tempj)], dims=dim(ind0))
12591259
# # object.size(X1des)
12601260
# rm(tempj)
@@ -1360,7 +1360,7 @@ X_hist <- function(mf, vary, args) {
13601360

13611361
# stack design-matrix of response nobs times in wide format
13621362
if(args$format == "wide"){
1363-
Bt <- Bt[rep(1:length(yind), each=nobs), ]
1363+
Bt <- Bt[rep(seq_along(yind), each=nobs), ]
13641364
}
13651365

13661366
if(! mboost_intern(Bt, fun = "isMATRIX") ) Bt <- matrix(Bt, ncol=1)
@@ -1574,7 +1574,7 @@ bhist <- function(x, s, time, index = NULL, #by = NULL,
15741574
if(length(value) != names(mf[1]))
15751575
stop(sQuote("value"), " must have same length as ",
15761576
sQuote("names(mf[1])"))
1577-
for (i in 1:length(value)){
1577+
for (i in seq_along(value)){
15781578
cll[[i+1]] <<- as.name(value[i])
15791579
}
15801580
attr(mf, "names") <<- value
@@ -1805,7 +1805,7 @@ bfpc <- function(x, s, index = NULL, df = 4,
18051805
if(length(value) != names(mf[1]))
18061806
stop(sQuote("value"), " must have same length as ",
18071807
sQuote("names(mf[1])"))
1808-
for (i in 1:length(value)){
1808+
for (i in seq_along(value)){
18091809
cll[[i+1]] <<- as.name(value[i])
18101810
}
18111811
attr(mf, "names") <<- value
@@ -1867,7 +1867,7 @@ X_bbsc <- function(mf, vary, args) {
18671867
MATRIX <- MATRIX && options("mboost_useMatrix")$mboost_useMatrix
18681868
if (MATRIX) {
18691869
diag <- Diagonal
1870-
for (i in 1:length(mm)){
1870+
for (i in seq_along(mm)){
18711871
tmp <- attributes(mm[[i]])[c("degree", "knots", "Boundary.knots")]
18721872
mm[[i]] <- Matrix(mm[[i]])
18731873
attributes(mm[[i]])[c("degree", "knots", "Boundary.knots")] <- tmp
@@ -2285,7 +2285,7 @@ bbsc <- function(..., by = NULL, index = NULL, knots = 10, boundary.knots = NULL
22852285
if(length(value) != length(colnames(mf)))
22862286
stop(sQuote("value"), " must have same length as ",
22872287
sQuote("colnames(mf)"))
2288-
for (i in 1:length(value)){
2288+
for (i in seq_along(value)){
22892289
cll[[i+1]] <<- as.name(value[i])
22902290
}
22912291
attr(mf, "names") <<- value
@@ -2559,7 +2559,7 @@ bolsc <- function(..., by = NULL, index = NULL, intercept = TRUE, df = NULL,
25592559
if(length(value) != length(colnames(mf)))
25602560
stop(sQuote("value"), " must have same length as ",
25612561
sQuote("colnames(mf)"))
2562-
for (i in 1:length(value)){
2562+
for (i in seq_along(value)){
25632563
cll[[i+1]] <<- as.name(value[i])
25642564
}
25652565
attr(mf, "names") <<- value

‎R/baselearnersX.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -522,7 +522,7 @@ bhistx <- function(x,
522522
if(length(value) != names(mf[1]))
523523
stop(sQuote("value"), " must have same length as ",
524524
sQuote("names(mf[1])"))
525-
for (i in 1:length(value)){
525+
for (i in seq_along(value)){
526526
cll[[i+1]] <<- as.name(value[i])
527527
}
528528
attr(mf, "names") <<- value

‎R/bootstrapCIs.R‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -251,7 +251,7 @@ bootstrapCI <- function(object, which = NULL,
251251

252252
########## format coefficients #########
253253
# number of baselearners
254-
nrEffects <- max(sapply(1:length(coefs),
254+
nrEffects <- max(sapply(seq_along(coefs),
255255
function(i) length(coefs[[i]]$smterms)))
256256

257257
isFacSpecEffect <- sapply(1:nrEffects,
@@ -272,10 +272,10 @@ bootstrapCI <- function(object, which = NULL,
272272
{
273273
if(isFacSpecEffect[i]){
274274
# factor specific effect
275-
lapply(1:length(coefs), function(j) lapply(1:(coefs[[1]]$smterms[[i]]$numberLevels),
275+
lapply(seq_along(coefs), function(j) lapply(1:(coefs[[1]]$smterms[[i]]$numberLevels),
276276
function(k) coefs[[j]]$smterms[[i]][[k]]$value))
277277
}else{
278-
lapply(1:length(coefs), function(j) coefs[[j]]$smterms[[i]]$value)
278+
lapply(seq_along(coefs), function(j) coefs[[j]]$smterms[[i]]$value)
279279
}
280280
})
281281

@@ -299,7 +299,7 @@ bootstrapCI <- function(object, which = NULL,
299299

300300
# add information about the values of the covariate
301301
# and change format
302-
for(i in 1:length(listOfCoefs)){
302+
for(i in seq_along(listOfCoefs)){
303303

304304
if(isFacSpecEffect[i]){
305305

@@ -319,7 +319,7 @@ bootstrapCI <- function(object, which = NULL,
319319
if(is.list(listOfCoefs[[i]]) & is.factor(atx)){
320320

321321
# combine each factor level
322-
listOfCoefs[[i]] <- lapply(1:length(levels(droplevels(atx))),
322+
listOfCoefs[[i]] <- lapply(seq_along(levels(droplevels(atx))),
323323
function(faclevnr) t(sapply(listOfCoefs[[i]], function(x) x[faclevnr,])))
324324
isSurface[i] <- FALSE
325325

@@ -375,7 +375,7 @@ bootstrapCI <- function(object, which = NULL,
375375
listOfQuantiles <- vector("list", length(listOfCoefs))
376376

377377
# calculate quantiles
378-
for(i in 1:length(listOfCoefs)){
378+
for(i in seq_along(listOfCoefs)){
379379

380380
# for matrix object
381381
if(is.matrix(listOfCoefs[[i]]) & !is.list(listOfCoefs[[i]])){
@@ -418,7 +418,7 @@ bootstrapCI <- function(object, which = NULL,
418418

419419
if(is.list(x)){
420420

421-
for(j in 1:length(x)){
421+
for(j in seq_along(x)){
422422

423423
if(!is.null(dim(x[[j]]))){
424424
rownames(x[[j]]) <- levels
@@ -512,7 +512,7 @@ plot.bootstrapCI <- function(x, which = NULL, pers = TRUE,
512512

513513
}
514514

515-
if(is.null(which)) which <- 1:length(x$raw_results)
515+
if(is.null(which)) which <- seq_along(x$raw_results)
516516

517517
oldpar <- par(no.readonly = TRUE)
518518
on.exit(par(oldpar))

‎R/crossvalidation.R‎

Lines changed: 19 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -248,7 +248,7 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
248248
## problem with index for bl containing index, and you do not get s for bsignal/bhist
249249
if(FALSE){
250250
dathelp2 <- list()
251-
for(j in 1:length(object$baselearner)){
251+
for(j in seq_along(object$baselearner)){
252252
dat_bl_j <- object$baselearner[[j]]$get_data() ## object$baselearner[[j]]$model.frame()
253253
# if the variable is already present, do not add it again
254254
dathelp2 <- c(dathelp2, dat_bl_j[!names(dat_bl_j) %in% names(dathelp2)])
@@ -317,7 +317,7 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
317317

318318
# for each missing variable get the first baselearner, which contains the variable
319319
blWithMissVars <- lapply(names_variables[whMiss], function(w)
320-
unlist(lapply(1:length(object$baselearner), function(i) if(
320+
unlist(lapply(seq_along(object$baselearner), function(i) if(
321321
any( grepl(w, object$baselearner[[i]]$get_names() ) )) return(i))
322322
)[1])
323323

@@ -352,7 +352,7 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
352352
if(any(isFac)){
353353
namesFac <- names(isFac)[isFac]
354354

355-
for(i in 1:length(namesFac)){
355+
for(i in seq_along(namesFac)){
356356

357357
if(length(levels(droplevels(dathelp[[namesFac[i]]]))) !=
358358
length(levels(droplevels(dat_weights[[namesFac[i]]]))))
@@ -963,11 +963,11 @@ validateFDboost <- function(object, response = NULL,
963963
oobpreds <- matrix(nrow = nrow(oobpreds0[[1]]), ncol = ncol(oobpreds0[[1]]))
964964

965965
if(any(class(object) == "FDboostLong")){
966-
for(i in 1:length(oobpreds0)){ # i runs over observed trajectories, i.e. over id
966+
for(i in seq_along(oobpreds0)){ # i runs over observed trajectories, i.e. over id
967967
oobpreds[id == i, ] <- oobpreds0[[i]][id == i, ]
968968
}
969969
}else{
970-
for(j in 1:length(oobpreds0)){
970+
for(j in seq_along(oobpreds0)){
971971
oobpreds[folds[ , j] == 0] <- oobpreds0[[j]][folds[ , j] == 0]
972972
}
973973
}
@@ -1008,7 +1008,7 @@ validateFDboost <- function(object, response = NULL,
10081008

10091009
### estimates of coefficients
10101010
timeHelp <- seq(min(modRisk[[1]]$mod$yind), max(modRisk[[1]]$mod$yind), l = 40)
1011-
for(l in 1:length(modRisk[[1]]$mod$baselearner)){
1011+
for(l in seq_along(modRisk[[1]]$mod$baselearner)){
10121012
# estimate the coefficients for the model of the first fold
10131013
my_coef <- coef(modRisk[[1]]$mod[optimalMstop],
10141014
which = l, n1 = 40, n2 = 20, n3 = 15, n4 = 10)$smterms[[1]]
@@ -1023,7 +1023,7 @@ validateFDboost <- function(object, response = NULL,
10231023
attr(coefCV[[l]]$value, "offset") <- NULL # as offset is the same within one model
10241024

10251025
# add estimates for the models of the other folds
1026-
coefCV[[l]]$value <- lapply(1:length(modRisk), function(g){
1026+
coefCV[[l]]$value <- lapply(seq_along(modRisk), function(g){
10271027
ret <- coef(modRisk[[g]]$mod[optimalMstop],
10281028
which = l, n1 = 40, n2 = 20, n3 = 15, n4 = 10)$smterms[[1]]$value
10291029
# if(l==1){
@@ -1036,7 +1036,7 @@ validateFDboost <- function(object, response = NULL,
10361036
## %X% with numberLevels coefficient values in a list
10371037
## lapply(1:coefCV[[l]]$numberLevels, function(x) coefCV[[l]][[x]]$value)
10381038
for(j in 1:coefCV[[l]]$numberLevels){
1039-
coefCV[[l]][[j]]$value <- lapply(1:length(modRisk), function(g){
1039+
coefCV[[l]][[j]]$value <- lapply(seq_along(modRisk), function(g){
10401040
ret <- coef(modRisk[[g]]$mod[optimalMstop],
10411041
which = l, n1 = 40, n2 = 20, n3 = 15, n4 = 10)$smterms[[1]][[j]]$value
10421042
attr(ret, "offset") <- NULL # as offset is the same within one model
@@ -1048,7 +1048,7 @@ validateFDboost <- function(object, response = NULL,
10481048
}
10491049

10501050
## predict offset
1051-
offset <- sapply(1:length(modRisk), function(g){
1051+
offset <- sapply(seq_along(modRisk), function(g){
10521052
# offset is vector of length yind or numeric of length 1 for constant offset
10531053
ret <- modRisk[[g]]$mod$predictOffset(time = timeHelp)
10541054
if( length(ret) == 1 & length(object$yind) > 1 ) ret <- rep(ret, length(timeHelp))
@@ -1063,7 +1063,7 @@ validateFDboost <- function(object, response = NULL,
10631063
# only makes sense for type="curves" with leaving-out one curve per fold!!
10641064
if(grepl("curves", type)){
10651065
for(l in 1:(length(modRisk[[1]]$mod$baselearner)+1)){
1066-
predCV[[l]] <- t(sapply(1:length(modRisk), function(g){
1066+
predCV[[l]] <- t(sapply(seq_along(modRisk), function(g){
10671067
if(l == 1){ # save offset of model
10681068
# offset is vector of length yind or numeric of length 1 for constant offset
10691069
ret <- modRisk[[g]]$mod[optimalMstop]$predictOffset(object$yind)
@@ -1356,7 +1356,7 @@ plotPredCoef <- function(x, which = NULL, pers = TRUE,
13561356

13571357
stopifnot(any(class(x) == "validateFDboost"))
13581358

1359-
if(is.null(which)) which <- 1:length(x$coefCV)
1359+
if(is.null(which)) which <- seq_along(x$coefCV)
13601360

13611361
oldpar <- par(no.readonly = TRUE)
13621362
on.exit(par(oldpar))
@@ -1365,7 +1365,7 @@ plotPredCoef <- function(x, which = NULL, pers = TRUE,
13651365

13661366
if(terms){
13671367

1368-
if(all(which == 1:length(x$coefCV))){
1368+
if(all(which == seq_along(x$coefCV))){
13691369
which <- 1:(length(x$coefCV)+1)
13701370
}else{
13711371
which <- which + 1
@@ -1387,7 +1387,7 @@ plotPredCoef <- function(x, which = NULL, pers = TRUE,
13871387

13881388
funplot(x$yind, unlist(x$predCV[[l]]), id=x$id, col="white",
13891389
main=names(x$predCV)[l], xlab=attr(x$yind, "nameyind"), ylab="coef", ylim=ylim, ...)
1390-
for(i in 1:length(x$predCV[[l]])){
1390+
for(i in seq_along(x$predCV[[l]])){
13911391
lines(x$yind[x$id==i], x$predCV[[l]][[i]], lwd=1, col=i)
13921392
if(showNumbers){
13931393
points(x$yind[x$id==i], x$predCV[[l]][[i]], type="p", pch=paste0(i))
@@ -1562,7 +1562,7 @@ plot_bootstrapped_coef <- function(temp, l,
15621562

15631563
# set lower triangular matrix to NA for historic effect
15641564
if(grepl("bhist", temp$main)){
1565-
for(k in 1:length(temp$value)){
1565+
for(k in seq_along(temp$value)){
15661566
temp$value[[k]][temp$value[[k]]==0] <- NA
15671567
}
15681568
}
@@ -1575,7 +1575,7 @@ plot_bootstrapped_coef <- function(temp, l,
15751575
# plot coefficient surfaces at different pointwise quantiles
15761576
if(pers){
15771577
matvec <- sapply(temp$value, c)
1578-
for(k in 1:length(probs)){
1578+
for(k in seq_along(probs)){
15791579

15801580
tempZ <- matrix(apply(matvec, 1, quantile, probs=probs[k], na.rm=TRUE), ncol=length(temp$x))
15811581

@@ -1592,7 +1592,7 @@ plot_bootstrapped_coef <- function(temp, l,
15921592

15931593
}else{ # do 2-dim plots
15941594

1595-
# for(j in 1:length(quanty)){
1595+
# for(j in seq_along(quanty)){
15961596
#
15971597
# myCol <- sapply(temp$value, function(x) x[, quanty[j]==temp$y]) # first column
15981598
#
@@ -1602,7 +1602,7 @@ plot_bootstrapped_coef <- function(temp, l,
16021602
#
16031603
# } # end loop over quanty
16041604
#
1605-
# for(j in 1:length(quantx)){
1605+
# for(j in seq_along(quantx)){
16061606
# myRow <- sapply(temp$value, function(x) x[quantx[j]==temp$x, ]) # first column
16071607
#
16081608
# plot_curves(x_i = temp$x, y_i = myRow, xlab_i = temp$xlab,
@@ -1612,7 +1612,7 @@ plot_bootstrapped_coef <- function(temp, l,
16121612
# }
16131613

16141614
matvec <- sapply(temp$value, c)
1615-
for(k in 1:length(probs)){
1615+
for(k in seq_along(probs)){
16161616

16171617
tempZ <- matrix(apply(matvec, 1, quantile, probs=probs[k], na.rm=TRUE), ncol=length(temp$x))
16181618

@@ -1633,7 +1633,7 @@ plot_bootstrapped_coef <- function(temp, l,
16331633

16341634
}else{ # temp$x is factor
16351635

1636-
for(j in 1:length(quantx)){
1636+
for(j in seq_along(quantx)){
16371637

16381638
# impute matrix of 0 if effect was never chosen
16391639
temp$value[sapply(temp$value, function(x) is.null(dim(x)))] <- list(matrix(0, ncol=20, nrow=length(quantx)))

0 commit comments

Comments
 (0)