Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Sampling in r without consecutive identical digits

Tags:

r

I'm fairly new to R, but I've done a lot of searching and haven't found an answer to my question.

I have a vector with many repetitions of 8 digits:

allNum <- c(rep(1, 70), rep(2, 70), rep(3, 35), rep(4, 35), 
            rep(5, 70), rep(6, 70), rep(7, 35), rep(8, 35))

Now I want to take a permutation of this (presumably using sample(allNum, 420, replace=FALSE)), but I do not want any consecutive identical digits -- for example: 1 2 2 8

Is there a simple way to do this?

like image 729
icnhaap Avatar asked Apr 04 '13 18:04

icnhaap


1 Answers

You have an issue where there is the possibility of choosing elements randomly versus being constrained on your choices. In particular, if the number of elements you have to choose from is more than $2n-1$ where $n$ is the number of times the most frequent element occurs, you can choose a random element (consistent with the previous constraints). However, if those numbers are equal, then the most frequent value must be in every-other position for the rest of the sequence (and the values between can be randomly assigned). Recognizing this constraint allows a single pass through (no more random selections than there are elements in the original vector).

permute.nonconsec <- function(allNum) {
  fully.constrained <- function(x) {
    2*max(table(x)) - 1 == length(x)
  }
  permuted <- numeric(length(allNum))
  permuted[1] <- sample(allNum, 1)
  allNum <- allNum[-min(which(allNum==permuted[1]))]
  for (i in seq_along(allNum)+1) {
    if(fully.constrained(allNum)) {
      # switch to deterministic algorithm
      # determine which value is the constraining one
      r <- rle(sort(allNum))
      limiter <- r$values[r$lengths==max(r$lengths)]
      permuted[seq(i, length(permuted), by=2)] <- limiter
      remaining <- allNum[allNum != limiter]
      if (length(remaining)>0) {
        permuted[seq(i+1, length(permuted), by=2)] <- 
          remaining[sample.int(length(remaining))]
      }
      break;
    }
    available <- allNum[allNum != permuted[i-1]]
    permuted[i] <- available[sample.int(length(available), 1)]
    allNum <- allNum[-min(which(allNum==permuted[i]))]
  }
  permuted
}

This will fail if there is no possible arrangement: length(x) < 2 * max(table(x)) - 1, but an initial check for that could be added if desired.

like image 79
Brian Diggs Avatar answered Oct 31 '22 07:10

Brian Diggs