Вы почти у цели.Вы можете изменить определение sorted на
sorted <- out[order(k, -mean.y), ]
И тогда sorted[1,] (или, если вы предпочитаете sorted[1,,drop=FALSE]) - ваш выбранный набор.
Если вы хотите, чтобы индексы скореечем / в дополнение к пунктам, то вы можете включить это ранее.Замените:
x <- t(combn(dat.grp.1$x1, 5))
y <- t(combn(dat.grp.1$x2, 5))
на
idx <- t(combn(1:nrow(dat.grp.1), 5))
x <- t(apply(idx, 1, function(i) {dat.grp.1[i,"x1"]}))
y <- t(apply(idx, 1, function(i) {dat.grp.1[i,"x2"]}))
и включите idx в out позже.
Соедините все вместе:
##### pulling out the first group for demonstration
dat.grp.1 <- dat[ which(grp == 1), ]
crit <- 55
idx <- t(combn(1:nrow(dat.grp.1), 5))
x <- t(apply(idx, 1, function(i) {dat.grp.1[i,"x1"]}))
y <- t(apply(idx, 1, function(i) {dat.grp.1[i,"x2"]}))
mean.x <- rowMeans(x)
mean.y <- rowMeans(y)
k <- (mean.x - crit)^2
out <- cbind(idx, x, mean.x, k, y, mean.y)
##### finding the sets with the least amount of discrepancy and among
##### those the largest second mean
pick <- out[order(k, -mean.y)[1],,drop=FALSE]
pick
, который дает
mean.x k mean.y
[1,] 3 8 10 11 18 55 48 48 47 52 50 25 0.62 0.31 0.18 0.48 0.54 0.426
РЕДАКТИРОВАТЬ: запрошено описание применения свыше idx;Я хочу больше вариантов, чем просто то, что я могу сделать в комментарии, поэтому я добавляю его в свой ответ.Будут также рассмотрены циклы над подмножествами.
idx - это матрица (15504 x 5), каждая строка которой представляет собой набор (5) индексов для кадра данных.apply позволяет проходить строку за строкой (строка за строкой - поле 1), чтобы что-то делать с каждой строкой.Это что-то, возьмите значения и используйте их для индексации нужных строк dat.grp.1 и извлечения соответствующих значений x1.Я мог бы написать dat.grp.1[i,"x1"] как dat.grp.1$x1[i].Каждая строка idx становится столбцом, а результаты индексации в dat.grp.1 являются строками, поэтому все это необходимо транспонировать.
Вы можете разбить цикл на части, чтобы увидеть, как работает каждый шаг, еслитебе нравится.Превратите функцию в неанонимную функцию.
f <- function(i) {dat.grp.1[i,"x1"]}
и передайте ей строку idx.
> f(idx[1,])
[1] 45 27 55 39 41
> f(idx[2,])
[1] 45 27 55 39 29
> f(idx[3,])
[1] 45 27 55 39 47
> f(idx[4,])
[1] 45 27 55 39 48
Это то, что входит в x
> head(x,4)
[,1] [,2] [,3] [,4] [,5]
[1,] 45 27 55 39 41
[2,] 45 27 55 39 29
[3,] 45 27 55 39 47
[4,] 45 27 55 39 48
Что касается зацикливания подмножеств, библиотека plyr очень удобна для этого.Способ, которым вы его настроили (назначить интересующее подмножество переменной и работаете с этим), упрощает преобразование.Все, что вы делаете для создания ответа для одного подмножества, входит в функцию с этой частью в качестве параметра.
find.best.set <- function(dat.grp.1) {
crit <- 55
idx <- t(combn(1:nrow(dat.grp.1), 5))
x <- t(apply(idx, 1, function(i) {dat.grp.1[i,"x1"]}))
y <- t(apply(idx, 1, function(i) {dat.grp.1[i,"x2"]}))
mean.x <- rowMeans(x)
mean.y <- rowMeans(y)
k <- (mean.x - crit)^2
out <- cbind(idx, x, mean.x, k, y, mean.y)
out[order(k, -mean.y)[1],,drop=FALSE]
}
Это в основном то, что вы имели раньше, но избавляетесь от некоторых ненужных назначений.
Теперь оберните это в plyr вызов.
library("plyr")
ddply(dat, .(grp), find.best.set)
, который дает
grp V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18
1 1 3 8 10 11 18 55 48 48 47 52 50 25 0.62 0.31 0.18 0.48 0.54 0.426
2 2 8 10 12 15 16 53 35 55 76 56 55 0 0.71 0.20 0.43 0.50 0.70 0.508
3 3 4 10 15 17 20 47 48 73 55 52 55 0 0.67 0.54 0.28 0.42 0.31 0.444
4 4 2 11 13 17 19 47 46 70 62 50 55 0 0.35 0.47 0.18 0.13 0.47 0.320
5 5 3 6 10 17 19 72 40 58 66 39 55 0 0.33 0.42 0.32 0.32 0.51 0.380
Я не знаю, что это лучший формат для ваших результатов, но он отражаетпример, который вы привели.