/
codes.R
86 lines (61 loc) · 2.69 KB
/
codes.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
# function to create CV groups based on alfa-latice principles
# ten-fold with two replicates
tenfoldCV <- function(gid, seed = 29121983){
require(agricolae)
gid <- as.character(gid)
replicates <- 2
folds <- 10
rest <- length(gid) - trunc(length(gid)/folds)*folds
lb <- length(gid) - rest
if (rest == 0) {
book <- design.alpha(trt = gid, r = replicates, s = length(gid) / folds, k = folds, seed = seed)$book
book <- data.frame(replicate = book[,5], fold = book[,2], gid = book[,4])
rownames(book) <- NULL
return(book)
}
if (rest > 0) {
book <- design.alpha(trt = gid[1:lb], r = replicates, s = lb / folds, k = folds, seed = seed)$book
book <- data.frame(replicate = book[,5], fold = book[,2], gid = book[,4])
book2 <- data.frame(replicate = rep(1:replicates, each = rest), fold = c(sample(1:folds, rest), sample(1:folds, rest)), gid = c(gid[(lb+1):length(gid)]
, gid[(lb+1):length(gid)]))
book3 <- rbind(book, book2)
rownames(book3) <- NULL
return(book3)
}
}
#################
# function to create CV groups based on alfa-latice principles
# five-fold with four replicates
fivefoldCV <- function(gid, seed = 29121983){
require(agricolae)
gid = as.character(gid)
replicates <- 4
folds <- 5
lb <- length(gid)
s <- lb / folds
odds <- seq(from = 1, to = s, by = 2)
dvby3 <- (s / 3) - trunc(s / 3)
while (!s %in% odds | dvby3 == 0) {
lb <- (lb - 1)
s <- lb / folds # must be odd and not divisible by three
dvby3 <- (s / 3) - trunc(s / 3) # Thus, it must be != 0
}
rest <- length(gid) - lb
if (rest == 0) {
book <- design.alpha(trt = gid, r = replicates, s = s, k = folds, seed = seed)$book
book <- data.frame(replicate = book[,5], fold = book[,2], gid = book[,4])
rownames(book) <- NULL
return(book)
}
if (rest > 0) {
book <- design.alpha(trt = gid[1:lb], r = replicates, s = s, k = folds, seed = seed)$book
book <- data.frame(replicate = book[,5], fold = book[,2], gid = book[,4])
book2 <- data.frame(replicate = rep(1:replicates, each = rest), fold = c(sample(1:folds, rest, replace = TRUE), sample(1:folds, rest, replace = TRUE), sample(1:folds, rest, replace = TRUE), sample(1:folds, rest, replace = TRUE)), gid = c(gid[(lb + 1):length(gid)], gid[(lb + 1):length(gid)], gid[(lb + 1):length(gid)], gid[(lb + 1):length(gid)]))
book3 <- rbind(book, book2)
rownames(book3) <- NULL
non.ortho <- rest/length(gid)*100
cat(rest, "individual were not assigned in the main scheme, that represent", non.ortho, "%")
output <- list(CV = book3, size = length(gid), rest = rest, non.ortho = non.ortho)
return(output)
}
}