Skip to content

Commit

Permalink
Use full argument name for situations with restricted partial matching (
Browse files Browse the repository at this point in the history 
#1361)

* Rename 'form' to 'formula' for settings with partial matching restrictions

* also seq(along=) partial matching

* many more seq(along= cases

* seq(length=)

---------

Co-authored-by: topepo <[email protected]>
  • Loading branch information
@MichaelChirico @topepo
MichaelChirico and topepo authored Nov 25, 2024
1 parent 0aadaf2 commit 14dbdc5
Show file tree
Hide file tree
Showing 46 changed files with 213 additions and 212 deletions.
2 changes: 1 addition & 1 deletion pkg/caret/R/aaa.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -94,7 +94,7 @@ if(getRversion() >= "2.15.1"){
## nominalTrainWorkflow: no visible binding for global variable 'Resample'
## oobTrainWorkflow: no visible binding for global variable 'parm'
##
## result <- foreach(iter = seq(along = resampleIndex),
## result <- foreach(iter = seq(along.with = resampleIndex),
## .combine = "c", .verbose = FALSE,
## .packages = "caret", .errorhandling = "stop") %:%
## foreach(parm = 1:nrow(info$loop), .combine = "c",
Expand Down
56 changes: 28 additions & 28 deletions pkg/caret/R/adaptive.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,12 +22,12 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
pkgs <- c("methods", "caret")
if(!is.null(method$library)) pkgs <- c(pkgs, method$library)

init_index <- seq(along = resampleIndex)[1:(ctrl$adaptive$min-1)]
extra_index <- seq(along = resampleIndex)[-(1:(ctrl$adaptive$min-1))]
init_index <- seq(along.with = resampleIndex)[1:(ctrl$adaptive$min-1)]
extra_index <- seq(along.with = resampleIndex)[-(1:(ctrl$adaptive$min-1))]

keep_pred <- isTRUE(ctrl$savePredictions) || ctrl$savePredictions %in% c("all", "final")

init_result <- foreach(iter = seq(along = init_index),
init_result <- foreach(iter = seq(along.with = init_index),
.combine = "c",
.verbose = FALSE,
.errorhandling = "stop") %:%
Expand Down Expand Up @@ -91,14 +91,14 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
nPred <- length(holdoutIndex)
if(!is.null(lev)) {
predicted <- rep("", nPred)
predicted[seq(along = predicted)] <- NA
predicted[seq(along.with = predicted)] <- NA
} else {
predicted <- rep(NA, nPred)
}
if(!is.null(submod)) {
tmp <- predicted
predicted <- vector(mode = "list", length = nrow(info$submodels[[parm]]) + 1)
for(i in seq(along = predicted)) predicted[[i]] <- tmp
for(i in seq(along.with = predicted)) predicted[[i]] <- tmp
rm(tmp)
}
}
Expand All @@ -117,14 +117,14 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
nPred <- length(holdoutIndex)
if(!is.null(lev)) {
predicted <- rep("", nPred)
predicted[seq(along = predicted)] <- NA
predicted[seq(along.with = predicted)] <- NA
} else {
predicted <- rep(NA, nPred)
}
if(!is.null(submod)) {
tmp <- predicted
predicted <- vector(mode = "list", length = nrow(info$submodels[[parm]]) + 1)
for(i in seq(along = predicted)) predicted[[i]] <- tmp
for(i in seq(along.with = predicted)) predicted[[i]] <- tmp
rm(tmp)
}
}
Expand All @@ -145,7 +145,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
{
tmp <- probValues
probValues <- vector(mode = "list", length = nrow(info$submodels[[parm]]) + 1)
for(i in seq(along = probValues)) probValues[[i]] <- tmp
for(i in seq(along.with = probValues)) probValues[[i]] <- tmp
rm(tmp)
}
}
Expand Down Expand Up @@ -175,12 +175,12 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,

## same for the class probabilities
if(ctrl$classProbs) {
for(k in seq(along = predicted)) predicted[[k]] <- cbind(predicted[[k]], probValues[[k]])
for(k in seq(along.with = predicted)) predicted[[k]] <- cbind(predicted[[k]], probValues[[k]])
}

if(keep_pred) {
tmpPred <- predicted
for(modIndex in seq(along = tmpPred))
for(modIndex in seq(along.with = tmpPred))
{
tmpPred[[modIndex]]$rowIndex <- holdoutIndex
tmpPred[[modIndex]] <- merge(tmpPred[[modIndex]],
Expand All @@ -201,7 +201,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
if(length(lev) > 1) {
cells <- lapply(predicted,
function(x) flatTable(x$pred, x$obs))
for(ind in seq(along = cells)) thisResample[[ind]] <- c(thisResample[[ind]], cells[[ind]])
for(ind in seq(along.with = cells)) thisResample[[ind]] <- c(thisResample[[ind]], cells[[ind]])
}
thisResample <- do.call("rbind", thisResample)
thisResample <- cbind(allParam, thisResample)
Expand Down Expand Up @@ -315,14 +315,14 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
nPred <- length(holdoutIndex)
if(!is.null(lev)) {
predicted <- rep("", nPred)
predicted[seq(along = predicted)] <- NA
predicted[seq(along.with = predicted)] <- NA
} else {
predicted <- rep(NA, nPred)
}
if(!is.null(submod)) {
tmp <- predicted
predicted <- vector(mode = "list", length = nrow(new_info$submodels[[parm]]) + 1)
for(i in seq(along = predicted)) predicted[[i]] <- tmp
for(i in seq(along.with = predicted)) predicted[[i]] <- tmp
rm(tmp)
}
}
Expand All @@ -341,14 +341,14 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
nPred <- length(holdoutIndex)
if(!is.null(lev)) {
predicted <- rep("", nPred)
predicted[seq(along = predicted)] <- NA
predicted[seq(along.with = predicted)] <- NA
} else {
predicted <- rep(NA, nPred)
}
if(!is.null(submod)) {
tmp <- predicted
predicted <- vector(mode = "list", length = nrow(new_info$submodels[[parm]]) + 1)
for(i in seq(along = predicted)) predicted[[i]] <- tmp
for(i in seq(along.with = predicted)) predicted[[i]] <- tmp
rm(tmp)
}
}
Expand All @@ -369,7 +369,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
{
tmp <- probValues
probValues <- vector(mode = "list", length = nrow(new_info$submodels[[parm]]) + 1)
for(i in seq(along = probValues)) probValues[[i]] <- tmp
for(i in seq(along.with = probValues)) probValues[[i]] <- tmp
rm(tmp)
}
}
Expand Down Expand Up @@ -400,12 +400,12 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,

## same for the class probabilities
if(ctrl$classProbs) {
for(k in seq(along = predicted)) predicted[[k]] <- cbind(predicted[[k]], probValues[[k]])
for(k in seq(along.with = predicted)) predicted[[k]] <- cbind(predicted[[k]], probValues[[k]])
}

if(keep_pred) {
tmpPred <- predicted
for(modIndex in seq(along = tmpPred))
for(modIndex in seq(along.with = tmpPred))
{
tmpPred[[modIndex]]$rowIndex <- holdoutIndex
tmpPred[[modIndex]] <- merge(tmpPred[[modIndex]],
Expand All @@ -426,7 +426,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
if(length(lev) > 1) {
cells <- lapply(predicted,
function(x) flatTable(x$pred, x$obs))
for(ind in seq(along = cells)) thisResample[[ind]] <- c(thisResample[[ind]], cells[[ind]])
for(ind in seq(along.with = cells)) thisResample[[ind]] <- c(thisResample[[ind]], cells[[ind]])
}
thisResample <- do.call("rbind", thisResample)
thisResample <- cbind(allParam, thisResample)
Expand Down Expand Up @@ -541,7 +541,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
printed <- format(new_info$loop, digits = 4)
colnames(printed) <- gsub("^\\.", "", colnames(printed))

final_index <- seq(along = resampleIndex)[(last_iter+1):length(ctrl$index)]
final_index <- seq(along.with = resampleIndex)[(last_iter+1):length(ctrl$index)]
final_result <- foreach(iter = final_index,
.combine = "c",
.verbose = FALSE) %:%
Expand Down Expand Up @@ -604,14 +604,14 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
nPred <- length(holdoutIndex)
if(!is.null(lev)) {
predicted <- rep("", nPred)
predicted[seq(along = predicted)] <- NA
predicted[seq(along.with = predicted)] <- NA
} else {
predicted <- rep(NA, nPred)
}
if(!is.null(submod)) {
tmp <- predicted
predicted <- vector(mode = "list", length = nrow(info$submodels[[parm]]) + 1)
for(i in seq(along = predicted)) predicted[[i]] <- tmp
for(i in seq(along.with = predicted)) predicted[[i]] <- tmp
rm(tmp)
}
}
Expand All @@ -630,14 +630,14 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
nPred <- length(holdoutIndex)
if(!is.null(lev)) {
predicted <- rep("", nPred)
predicted[seq(along = predicted)] <- NA
predicted[seq(along.with = predicted)] <- NA
} else {
predicted <- rep(NA, nPred)
}
if(!is.null(submod)) {
tmp <- predicted
predicted <- vector(mode = "list", length = nrow(info$submodels[[parm]]) + 1)
for(i in seq(along = predicted)) predicted[[i]] <- tmp
for(i in seq(along.with = predicted)) predicted[[i]] <- tmp
rm(tmp)
}
}
Expand All @@ -658,7 +658,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
{
tmp <- probValues
probValues <- vector(mode = "list", length = nrow(info$submodels[[parm]]) + 1)
for(i in seq(along = probValues)) probValues[[i]] <- tmp
for(i in seq(along.with = probValues)) probValues[[i]] <- tmp
rm(tmp)
}
}
Expand Down Expand Up @@ -689,12 +689,12 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,

## same for the class probabilities
if(ctrl$classProbs) {
for(k in seq(along = predicted)) predicted[[k]] <- cbind(predicted[[k]], probValues[[k]])
for(k in seq(along.with = predicted)) predicted[[k]] <- cbind(predicted[[k]], probValues[[k]])
}

if(keep_pred) {
tmpPred <- predicted
for(modIndex in seq(along = tmpPred))
for(modIndex in seq(along.with = tmpPred))
{
tmpPred[[modIndex]]$rowIndex <- holdoutIndex
tmpPred[[modIndex]] <- merge(tmpPred[[modIndex]],
Expand All @@ -715,7 +715,7 @@ adaptiveWorkflow <- function(x, y, wts, info, method, ppOpts, ctrl, lev,
if(length(lev) > 1) {
cells <- lapply(predicted,
function(x) flatTable(x$pred, x$obs))
for(ind in seq(along = cells)) thisResample[[ind]] <- c(thisResample[[ind]], cells[[ind]])
for(ind in seq(along.with = cells)) thisResample[[ind]] <- c(thisResample[[ind]], cells[[ind]])
}
thisResample <- do.call("rbind", thisResample)
thisResample <- cbind(allParam, thisResample)
Expand Down
4 changes: 2 additions & 2 deletions pkg/caret/R/additive.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,11 +10,11 @@ additivePlot <- function(x, data, n = 100, quant = 0, plot = TRUE, ...)
function(x, len, q) list(seq = seq(
quantile(x, na.rm = TRUE, probs = q),
quantile(x, na.rm = TRUE, probs = 1 - q),
length = len),
length.out = len),
var = ""),
len = n,
q = quant)
for(i in seq(along = seqs)) seqs[[i]]$var <- colnames(data)[i]
for(i in seq(along.with = seqs)) seqs[[i]]$var <- colnames(data)[i]
meds <- lapply(data,
function(x, len) rep(median(x, na.rm = TRUE), len),
len = n)
Expand Down
2 changes: 1 addition & 1 deletion pkg/caret/R/avNNet.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,7 +113,7 @@ avNNet.default <- function(x, y, repeats = 5,
## check for factors
## this is from nnet.formula

ind <- seq(along = y)
ind <- seq(along.with = y)
if(is.factor(y))
{
classLev <- levels(y)
Expand Down
4 changes: 2 additions & 2 deletions pkg/caret/R/bag.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,7 @@ bagControl <- function(
{
freaks <- table(subY)
smallFreak <- min(freaks)
splitUp <- split(seq(along = subY), subY)
splitUp <- split(seq(along.with = subY), subY)
splitUp <- lapply(splitUp,
sample,
size = smallFreak)
Expand Down Expand Up @@ -173,7 +173,7 @@ bagControl <- function(
btSamples <- createResample(y, times = B)

`%op%` <- if(bagControl$allowParallel) `%dopar%` else `%do%`
btFits <- foreach(iter = seq(along = btSamples),
btFits <- foreach(iter = seq(along.with = btSamples),
.verbose = FALSE,
.packages = "caret",
.errorhandling = "stop") %op%
Expand Down
2 changes: 1 addition & 1 deletion pkg/caret/R/bagEarth.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -260,7 +260,7 @@
requireNamespaceQuietStop("earth")
## get oob predictions
getTrainPred <- function(x) {
oobIndex <- seq(along = x$fitted.values)
oobIndex <- seq(along.with = x$fitted.values)
oobIndex <- oobIndex[!(oobIndex %in% unique(x$index))]
data.frame(pred = x$fitted.values[oobIndex],
sample = oobIndex)
Expand Down
2 changes: 1 addition & 1 deletion pkg/caret/R/bagFDA.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -204,7 +204,7 @@ function(object, newdata = NULL, type = "class", ...)
}
pred <- rbind.fill(pred)
out <- ddply(pred, .(sample),
function(x) colMeans(x[,seq(along = object$levels)], na.rm = TRUE))
function(x) colMeans(x[,seq(along.with = object$levels)], na.rm = TRUE))
out <- out[,-1,drop = FALSE]
rownames(out) <- rownames(newdata)
predClass <- object$levels[apply(out, 1, which.max)]
Expand Down
2 changes: 1 addition & 1 deletion pkg/caret/R/classDist.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ classDist.default <- function(x, y, groups = 5,
if(is.numeric(y))
{
y <- cut(y,
unique(quantile(y, probs = seq(0, 1, length = groups + 1))),
unique(quantile(y, probs = seq(0, 1, length.out = groups + 1))),
include.lowest = TRUE)
classLabels <- paste(round((1:groups)/groups*100, 2))
y <- factor(y)
Expand Down
2 changes: 1 addition & 1 deletion pkg/caret/R/classLevels.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ levels.train <- function(x, ...) {
} else code <- x$modelInfo
if(!is.null(code$levels)){
checkInstall(code$library)
for(i in seq(along = code$library))
for(i in seq(along.with = code$library))
do.call("requireNamespaceQuietStop", list(package = code$library[i]))
out <- code$levels(x$finalModel, ...)
} else out <- NULL
Expand Down
2 changes: 1 addition & 1 deletion pkg/caret/R/confusionMatrix.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -281,7 +281,7 @@ confusionMatrix.table <- function(data, positive = NULL,

tableStats <- matrix(NA, nrow = length(classLevels), ncol = 11)

for(i in seq(along = classLevels)) {
for(i in seq(along.with = classLevels)) {
pos <- classLevels[i]
neg <- classLevels[!(classLevels %in% classLevels[i])]
prev <- if(is.null(prevalence)) sum(data[, pos])/sum(data) else prevalence[pos]
Expand Down
Loading

0 comments on commit 14dbdc5

Please sign in to comment.