R : 교체없이 동일한 연속 값없이 샘플링하는 방법


10

나는 매우 간단한 것으로 보이는 것을 성취하기 위해 하루를 보냈습니다. 1,2,3 및 4의 숫자가 모두 정확히 12 번 나타나는 300 개의 '무작위'시퀀스를 만들어야하지만 동일한 수는 두 번의 '행에서'/ 연속적으로 사용되지 않습니다.

최선의 시도는 다음과 같습니다.

  1. R 샘플 48 개 항목을 교체하지 않고 rle을 사용하여 연속 값이 있는지 테스트 한 후 연속 값을 포함하지 않는 시퀀스 만 사용하십시오. 문제 :이 기준을 충족시키는 임의의 시퀀스가 ​​거의 없으므로 영원히 걸립니다.

  2. R은 연속적인 값없이 시퀀스를 생성합니다 (코드 참조).

pop<-rep(1:4,12)
y=c()
while(length(y)!=48)
  {
  y= c(y,sample(pop,48-length(y),replace=F))
  y=y[!c(FALSE, diff(y) == 0)]
  }

문제 : 각 값의 개수가 다른 시퀀스를 만듭니다. 그런 다음 각 값의 정확히 12가있는 시퀀스 만 사용하려고했지만 문제 1로 돌아 왔습니다. 영원히 걸립니다.

이 작업을 수행하는 쉬운 방법이 있어야합니다. 어떤 도움이라도 대단히 감사합니다!

답변:


3

루프 replicate()와 함께 사용 하는 repeat것이 더 빠를 수도 있습니다. 여기에 3시퀀스가 있는 예제가 있습니다. 대략 소요되는 것 같습니다. 300(테스트되지 않음) 사용시 1490 초

set.seed(42)
seqc <- rep(1:4, each=12)  # starting sequence

system.time(
  res <- replicate(3, {
    repeat {
      seqcs <- sample(seqc, 48, replace=FALSE) 
      if (!any(diff(seqcs) == 0)) break
    }
    seqcs
  })
)
#  user  system elapsed 
# 14.88    0.00   14.90 

res[1:10, ]
#       [,1] [,2] [,3]
#  [1,]    4    2    3
#  [2,]    1    1    4
#  [3,]    3    2    1
#  [4,]    1    1    4
#  [5,]    2    3    1
#  [6,]    4    1    2
#  [7,]    3    4    4
#  [8,]    2    1    1
#  [9,]    3    4    4
# [10,]    4    3    2

1
정말 고맙습니다! 100 개의 시퀀스를 만드는 데 800 초가 걸렸으며이 경우 완전히 허용됩니다. 내 문제를 해결했다!
CookieMons

1

또 다른 옵션은 Markov Chain Monte-Carlo 방법을 사용하여 2 개의 숫자를 무작위로 바꾸고 1) 동일한 숫자를 바꾸지 않고 2) 동일한 숫자가 두 개가 인접한 경우에만 새 샘플로 이동하는 것입니다. 상관 된 샘플을 처리하기 위해 많은 샘플을 생성 한 다음 임의로 300 개를 임의로 선택할 수 있습니다.

v <- rep(1:4, 12)
l <- 48
nr <- 3e5
m <- matrix(0, nrow=nr, ncol=l)
count <- 0
while(count < nr) {
    i <- sample(l, 2)
    if (i[1L] != i[2L]) {
        v[i] = v[i[2:1]]
        if (!any(diff(v)==0)) {
            count <- count + 1
            m[count, ] <- v
        } else {
            v[i] = v[i[2:1]]
        }
    }
}
a <- m[sample(nr, 300),]
a

1

연속적인 값을 꺼내 연속적이지 않은 곳에 배치 할 수 있습니다.

unConsecutive  <- function(x) {
    repeat{
        tt <- c(FALSE, diff(x)==0)
        if(any(tt)) {
            y <- x[which(tt)]
            x <- x[which(!tt)]
            i <- x != y[1]
            i  <- which(c(c(TRUE, diff(i)==0) & i,FALSE)
                        | c(FALSE, c(diff(i)==0, TRUE) & i))
            if(length(i) > 0) {
                i <- i[1]-1
                x <- c(x[seq_len(i)], y, x[i+seq_len(length(x)-i)])
            } else {
                x  <- c(x, y)
                break
            }
        } else {break}
    }
    x
}

unConsecutive(c(1,1,2))
#[1] 1 2 1
unConsecutive(c(1,1,1))
#[1] 1 1 1

set.seed(7)
system.time(
    res <- replicate(300, unConsecutive(sample(rep(1:4,12))))
)
#   user  system elapsed 
#  0.058   0.011   0.069 
all(apply(res, 2, table) == 12)
#[1] TRUE
all(apply(res, 2, diff) != 0)
#[1] TRUE
당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.