|
a |
|
b/allFunctions.R |
|
|
1 |
|
|
|
2 |
fitModel <- function(iter = 5, ...){ |
|
|
3 |
error = TRUE |
|
|
4 |
i = 1 |
|
|
5 |
while ((error) && (i < 5)){ |
|
|
6 |
model <- try(train(...)) |
|
|
7 |
error <- class(model) == "try-error" |
|
|
8 |
i = i + 1 |
|
|
9 |
} |
|
|
10 |
if (i == iter) { |
|
|
11 |
model = NA |
|
|
12 |
warning("Algorithm did not converge. Returning NAs") |
|
|
13 |
} |
|
|
14 |
return(model) |
|
|
15 |
} |
|
|
16 |
|
|
|
17 |
predictModel <- function(model, newdata){ |
|
|
18 |
if (class(model) == "train"){ |
|
|
19 |
predicted = predict.train(model, newdata = newdata) |
|
|
20 |
ts.acc = sum(test.cond == as.numeric(predicted)) / length(test.cond) |
|
|
21 |
} |
|
|
22 |
if (class(model) != "train"){ |
|
|
23 |
ts.acc = NA |
|
|
24 |
} |
|
|
25 |
return(ts.acc) |
|
|
26 |
} |
|
|
27 |
|
|
|
28 |
|
|
|
29 |
foldIndex <- function(data, nSamp = NULL, nFolds = 5, repeats = 2){ |
|
|
30 |
if(is.null(nSamp)) n = nrow(data) |
|
|
31 |
else n = nSamp |
|
|
32 |
|
|
|
33 |
indIn <- indOut <- list() |
|
|
34 |
|
|
|
35 |
for (j in 1:repeats){ |
|
|
36 |
tmpIn = createFolds(1:n, k = nFolds, list = TRUE, returnTrain = TRUE) |
|
|
37 |
tmpOut = lapply(tmpIn, function(x)c(1:n)[-x]) |
|
|
38 |
|
|
|
39 |
indIn = c(indIn, tmpIn) |
|
|
40 |
indOut = c(indOut, tmpOut) |
|
|
41 |
} |
|
|
42 |
|
|
|
43 |
nms = paste(rep(paste("Fold", 1:nFolds, sep = ""), repeats), |
|
|
44 |
rep(paste(".Rep", 1:repeats, sep = ""), c(rep(nFolds, repeats))), sep = "") |
|
|
45 |
names(indIn) <- names(indOut) <- nms |
|
|
46 |
return(list(indexIn = indIn, indexOut = indOut)) |
|
|
47 |
} |
|
|
48 |
|