1
$\begingroup$

EDIT: If I am not mistaken, the problem outlined below can also be expressed simpler in the following way:

Distribute a variable run (ranging from 1 to 5 with each value appearing exactly 5 times) randomly over all possible combinations of the two variables var1 (1 to 5) and var2 (a to e) in a way that the following condition is met: Each value of var2 may only appear once for each value of run.


I hope that CrossValidated is the correct place for this. If not, please point me to the right place. My problem is associated with the sampling process itself, so I chose CrossValidated.

Alright, I have the following problem which seemed pretty easy to me ... until I've tried solving it. This might be a nice brain twister for some of you.

  • I have 2 variables (var1 and var2). Both can have 5 possible values (1-5 and a-e).
  • I want to create 5 "compositions" of combinations of var1 and var2. Hence, my goal is to have a result dataset with 25 rows. This result dataset has to satisfy the following two conditions:
  1. Each combination of var1 and var2 (e.g., 4-a) should only appear once in the final dataset.
  2. In each "composition", each value of var2 should only appear once.

I wrote R code to do that. I will explain the code and the problem I am running into below the code.

urn <- expand.grid(composition = 1:5, var1 = 1:5, var2 = letters[1:5])

result <- data.frame()
for (comp.i in 1:5) {
  if (comp.i %% 1 == 0) cat("Composition", comp.i, "\n")
  comp.urn <- urn[urn$composition == comp.i,]
  comp.result <- data.frame(composition = numeric(), var1 = numeric(), var2 = character())
  for (var1.i in 1:5) {
    var1.urn <- comp.urn[comp.urn$var1 == var1.i,]
    drawn <- var1.urn[sample(1:nrow(var1.urn), 1),]
    while (drawn$var2 %in% comp.result$var2 | paste0(drawn$var1, "-", drawn$var2) %in% result$combination) {
      drawn <- var1.urn[sample(1:nrow(var1.urn), 1),]
    }
    comp.result <- rbind(comp.result, drawn)
  }
  comp.result$combination <- paste0(comp.result$var1, "-", comp.result$var2)
  result <- rbind(result, comp.result)
}

First, I create a global urn with all possible combinations. Then I iterate over "compositions" and get the part of the global urn which is currently relevant (this results in comp.urn). I then iterate over var1 and draw one case from its combinations (from var1.urn). If var2 of this case is already in the results for the current composition run (Condition 2 above) OR if the var1-var2 combination is already in the global result (Condition 1 above), I draw again because one of the conditions is not met.

Now the problem: If, for example, 5-b is drawn in composition run 1, but in composition run 3, the only combination that is still left after 4 successful draws is 5-b, the while loop above never terminates because the two conditions cannot be satisfied at the same time.

I have absolutely no idea how to solve this problem. I've tried brute-forcing it by sampling 25 cases from the global urn and do this so often until both conditions are met by chance. However, in my real application, I have 43 composition runs, 43 possible values for var1 and var2. So brute-forcing won't work in a reasonable time frame.

I would greatly appreciate your help!

$\endgroup$

2 Answers 2

1
$\begingroup$

I think this does what you want.

library(data.table)

setorder(
  as.data.table(
    expand.grid(
      var1 = 1:5,
      var2 = letters[1:5]
    )
  )[
    sample(25)
  ][
    , .(var1 = var1, run = 1:5), var2
  ][
    , 3:1
  ],
  run
)[]
#>     run var1 var2
#>  1:   1    4    b
#>  2:   1    5    a
#>  3:   1    5    c
#>  4:   1    3    e
#>  5:   1    1    d
#>  6:   2    1    b
#>  7:   2    3    a
#>  8:   2    1    c
#>  9:   2    1    e
#> 10:   2    3    d
#> 11:   3    5    b
#> 12:   3    2    a
#> 13:   3    2    c
#> 14:   3    2    e
#> 15:   3    2    d
#> 16:   4    3    b
#> 17:   4    1    a
#> 18:   4    3    c
#> 19:   4    4    e
#> 20:   4    5    d
#> 21:   5    2    b
#> 22:   5    4    a
#> 23:   5    4    c
#> 24:   5    5    e
#> 25:   5    4    d

The idea is to set the run by group using var2 after shuffling.

$\endgroup$
6
  • $\begingroup$ It does indeed! Thanks a lot… pretty easy solution as soon as you‘re seeing it written down :) $\endgroup$
    – swolf
    Jul 27, 2022 at 15:22
  • $\begingroup$ I am now seeing that I've underspecified my question. Another condition would be that each value of var1 should only appear once for each run. $\endgroup$
    – swolf
    Jul 28, 2022 at 5:57
  • 1
    $\begingroup$ Think of $n$ wrapping diagonals of length $n$ comprising a square matrix. Each diagonal is a run, and the rows/columns correspond to var1 and var2. You can shuffle the runs and the ordering within the runs, but there's only one way to do it. $\endgroup$
    – jblood94
    Jul 28, 2022 at 10:52
  • 1
    $\begingroup$ dt <- data.frame(var1 = sequence(rep(5, 5)), var2 = sequence(rep(5, 5), 0:4) %% 5L + 1L, run = rep(sample(5), each = 5))[vapply(0:4, function(x) 5L*x + sample(5), integer(5)),] $\endgroup$
    – jblood94
    Jul 28, 2022 at 11:08
  • 1
    $\begingroup$ You can also flip the rows/columns (doesn't matter which one), so that would be: dt <- data.frame(var1 = abs(6L*sample(0:1, 1) - sequence(rep(5, 5))), var2 = sequence(rep(5, 5), 0:4) %% 5L + 1L, run = rep(sample(5), each = 5))[vapply(0:4, function(x) 5L*x + sample(5), integer(5)),] $\endgroup$
    – jblood94
    Jul 28, 2022 at 11:24
1
$\begingroup$

Same process as jblood94 just in tidy:

library(dplyr)
df <- as.data.frame(
  expand.grid(
    var1 = letters[1:5],
    var2 = 1:5)) %>%
  .[sample(nrow(.)),] %>%
  group_by(var2) %>%
  mutate(run = 1:5) %>%
  ungroup()
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.