기준에 따라 요소의 하위 집합 선택 및 확인

Question

특정 조건을 충족하는 전체 요소 중에서 하위 집합을 선택하고 싶습니다. 약 20 개의 요소가 있으며 각 요소에는 여러 속성이 있습니다. 하나의 속성에 대해 고정 된 기준에서 가장 적은 양의 불일치를 제공하고 다른 속성에 대해 가장 높은 평균값을 제공하는 다섯 가지 요소를 선택하고 싶습니다.

마지막으로 20 개 요소의 여러 세트에이 기능을 적용하고 싶습니다.

지금까지 "손으로"부분 집합을 식별 할 수 있었지만 값 자체를 반환하는 것 외에도 값의 인덱스를 반환 할 수 있기를 바랍니다.

목적 :

1. I는 고정 값 (55)으로부터 어긋나는 최소이다 X1 다섯 개 값들의 세트를 찾고, X2의 평균값에 대한 최대 값을 제공하려는 것이다.

2. 여러 세트에 대해이 작업을 수행하고 싶습니다.

   ---

   ##### generating example data 
   ##### this has five groups, each with two variables x1 and x2 
   set.seed(271828) 
   
   grp <- gl(5,20) 
   x1 <- round(rnorm(100,45, 12), digits=0) 
   x2 <- round(rbeta(100,2,4), digits = 2) 
   id <- seq(1,100,1) 
   
   ##### this is how the data would arrive for me to analyze 
   dat <- as.data.frame(cbind(id,grp,x1,x2)) 
   

   ---

   자료는 각 요소에 대한 고유 식별자로 id와,이 포맷에 도착할 것이다

. ,

> pick 
        mean.x k       mean.y 
[1,] 55 47 48 48 52  50 25 0.62 0.08 0.31 0.18 0.54 0.346 
[2,] 55 48 48 47 52  50 25 0.62 0.31 0.18 0.48 0.54 0.426 

제가 이들 요소의 id 값을 반환하고자 :

---

##### pulling out the first group for demonstration 
dat.grp.1 <- dat[ which(grp == 1), ] 

crit <- 55 
x <- t(combn(dat.grp.1$x1, 5)) 
y <- t(combn(dat.grp.1$x2, 5)) 

mean.x <- rowMeans(x) 
mean.y <- rowMeans(y) 
k <- (mean.x - crit)^2 

out <- cbind(x, mean.x, k, y, mean.y) 

##### finding the sets with the least amount of discrepancy 
pick <- out[ which(k == min(k)), ] 
pick 

##### finding the sets with low discrepancy and high values of y (means of X2) by "hand" 
sorted <- out[order(k), ] 
head(sorted, n=20) 

pick의 값에 대하여

---

, I는 X1의 값이라는 것을 알 수 그래서 나는 요소 3, 8, 10, 11, 18을 선택한다는 것을 안다. (k과의 불일치가 같기 때문에 집합 2를 선택하지만 y에 대한 평균은 높다. 어). 이 "손으로"이렇게

는

> dat.grp.1 
    id grp x1 x2 
1 1 1 45 0.12 
2 2 1 27 0.34 
3 3 1 55 0.62 
4 4 1 39 0.32 
5 5 1 41 0.18 
6 6 1 29 0.47 
7 7 1 47 0.08 
8 8 1 48 0.31 
9 9 1 35 0.48 
10 10 1 48 0.18 
11 11 1 47 0.48 
12 12 1 31 0.29 
13 13 1 39 0.15 
14 14 1 36 0.54 
15 15 1 36 0.20 
16 16 1 38 0.40 
17 17 1 30 0.31 
18 18 1 52 0.54 
19 19 1 44 0.37 
20 20 1 31 0.20 

지금은 작동하지만, 가능한 한 "손 - 오프"로이 할 좋은 것입니다.

도움을 주시면 대단히 감사하겠습니다.

Answer 1

거의 다 왔어. 당신은

sorted <- out[order(k, -mean.y), ] 

그리고 sorted[1,]에 sorted의 당신의 정의를 변경 (또는 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"]})) 

와 나중에 out에 idx이 포함 교체합니다.

모두 함께 퍼팅 INT :

는

        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 

EDIT 제공

##### 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 

한다 : 요청 된 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 

이들의 plyr 도서관이 매우 편리 부분 집합을 통해 반복에 관해서는 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 

에 번들로 제공받을 것입니다. 설정 한 방식 (관심있는 하위 집합을 변수에 할당하고 그 변수로 작업)은 변형을 쉽게 만듭니다. 하나의 부분 집합에 대한 답을 생성하기 위해 수행하는 모든 작업은 해당 부분을 매개 변수로 사용하여 함수로 들어갑니다.

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 전화로 마무리하십시오. 나는 그 결과에 가장 적합한 형식이다 모르겠지만, 당신이 준 예를 반영

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 

을 제공

library("plyr") 
ddply(dat, .(grp), find.best.set) 

.