问基于R中条件的“随机”排序用于心理学研究

EN

# some vector of valences
val <- rep(1:3,each=50)

pseudoRandomize <- function(x, n){

  # take an initial sample
  out <- sample(val)
  # check if the sample is "bad" (containing sequences longer than n)
  bad.seq <- any(rle(out)$lengths > n)
  # length of the whole sample
  l0 <- length(out)

  while(bad.seq){
    # get lengths of all subsequences
    l1 <- rle(out)$lengths
    # find the bad ones
    ind <- l1 > n
    # take the last value of each bad sequence, and...
    for(i in cumsum(l1)[ind]){
      # take it out of the original sample
      tmp <- out[-i]
      # pick new position at random
      pos <- sample(2:(l0-2),1)
      # put the value back into the sample at the new position
      out <- c(tmp[1:(pos-1)],out[i],tmp[pos:(l0-1)])
    }
    # check if bad sequences (still) exist
    # if TRUE, then 'while' continues; if FALSE, then it doesn't
    bad.seq <- any(rle(out)$lengths > n)
  }
  # return the reordered sequence
  out

}

# simple unnamed vector
val <- rep(1:3,each=5)
pseudoRandomize(val, 2)

# gives:
# [1] 1 3 2 1 2 3 3 2 1 2 1 3 3 1 2

# when names assigned to the vector
names(val) <- 1:length(val)
pseudoRandomize(val, 2)

# gives (first row shows the names):
#  1 13  9  7  3 11 15  8 10  5 12 14  6  4  2 
#  1  3  2  2  1  3  3  2  2  1  3  3  2  1  1 

# reorder a data.frame using a named vector
dat <- data.frame(val=rep(1:3,each=5), stim=rep(letters[1:5],3))
val <- dat$val
names(val) <- 1:nrow(dat)

new.val <- pseudoRandomize(val, 2)
new.dat <- dat[as.integer(names(new.val)),]

# gives:
#    val stim
# 5    1    e
# 2    1    b
# 9    2    d
# 6    2    a
# 3    1    c
# 15   3    e
# ...

#Generate example data
s1 = data.frame(id=c(1:10),treat=NA)

#Setting the first two rows
s1[1,"treat"] <- sample(1:3,1)
s1[2,"treat"] <- sample(1:3,1)

#Looping through the remainder of the rows
for (i in 3:length(s1$id))
{
   s1[i,"treat"] <- sample(1:3,1)

   #Check if the treat value is equal to the previous two values.
   if (s1[i,"treat"]==s1[i-1,"treat"] & s1[i-1,"treat"]==s1[i-2,"treat"])

   #If so draw one of the values not equal to that value
   {
      a = 1:3
      remove <- s1[i,"treat"]
      a=a[!a==remove]
      s1[i,"treat"]  <- sample(a,1)
   }
}