Generating a pseudorandom binary sequence with conditions in R

Question

I am wanting to generate 5 blocks of pseudorandom binary sequences (to be stored in a data frame) with the following conditions for each block:

1. 150 0s

2. 25 1s

3. The sequence cannot begin or end with a 1

4. 1s must be separated by a minimum of one 0 and a maximum of 12 0s.

This is my current (unsuccessful) attempt. The issue here is that I end up with several cases of more than 12 consecutive 0s and this tends to happen at the end of the block. I am not too concerned about the distribution, just the number of 0s that separate 1s.

library(plyr)
library(EnvStats)
#> 
#> Attaching package: 'EnvStats'
#> The following objects are masked from 'package:stats':
#> 
#>     predict, predict.lm

# variables
lure <- 1
target <- 0
nBlock <- 5
ntrialBlock <- 175
nTrial <- nBlock * ntrialBlock
nLureTrials <- 125
nTargets <- nTrial - nLureTrials
distMean <- 6.23
distSD <- 2.55
distLower <- 1
distUpper <- 12

# create trials and block numbers
block <- rep(1:nBlock, each=ntrialBlock) 
trial <- 1:nTrial

# store in data frame for trial matrix
trialMatrix <- data.frame(block, trial)

# pseudorandomisation
nLureTrialsBlock <- nLureTrials/nBlock

lureMatrix <- ddply(trialMatrix, .(block), function(trialMatrix) {
  
  lureMatrix <- data.frame()
  blockSum <- 0
  blockSet <- data.frame(x = numeric())
  blockTotal <- 0
  blockAg <- blockSum + (ntrialBlock*(trialMatrix[1,1]-1))
  
  while ((nrow(blockSet) != nLureTrialsBlock) & (blockSum < (ntrialBlock-distUpper))) {
    
    rand_draw <- round(rnorm(1, mean = distMean, sd = distSD))
    # Append to array
    blockSet[nrow(blockSet) + 1,] <- rand_draw
    # Get number of congruent trials in this block
    blockSum <- sum(blockSet)
    # Get trial numbers which are congruent trials
    # Take cumulative sum (keep adding prev trial)
    blockTotal <- cumsum(blockSet)
    blockAg <- blockSum + (ntrialBlock*(trialMatrix[1,1]-1)) 
    
  }
  
  blockSet <- cumsum(blockSet) + (ntrialBlock*(trialMatrix[1,1]-1))
  lureMatrix <- rbind(lureMatrix, blockSet) 
  
  return(lureMatrix)
  
}) 

# store lures in trialMatrix
trialMatrix[lureMatrix$x, "lure"] <- 1
trialMatrix[is.na(trialMatrix)] <- 0

^{Created on 2024-06-19 with reprex v2.1.0}

Answer 1

You can try a "brute force" approach, which doesn't take too long to succeed. The rle function can be used to determine the length of consecutive values.

data <- data.frame(block=rep(1:5, each=175), trial=seq(1, 175*5)) 

f <- function(n0, n1) {
  x <- c(0, 
         sample(c(rep(0,148), rep(1,25)), size=173, replace=FALSE), 
         0) # initial guess

  while(any(rle(x)$lengths[which(rle(x)$values==0)] > n0) ||
        any(rle(x)$lengths[which(rle(x)$values==1)] > n1)) {

    x <- c(0, 
           sample(c(rep(0,148), rep(1,25)), size=173, replace=FALSE), 
           0)
  }
  x
}

data <- dplyr::mutate(data, lure=f(n0=12, n1=1), .by=block)