Simulating Random Draws From a "Hat"

Question

Suppose I have the following 10 variables (num_var_1, num_var_2, num_var_3, num_var_4, num_var_5, factor_var_1, factor_var_2, factor_var_3, factor_var_4, factor_var_5):

set.seed(123)

num_var_1 <- rnorm(1000, 10, 1)
num_var_2 <- rnorm(1000, 10, 5)
num_var_3 <- rnorm(1000, 10, 10)
num_var_4 <- rnorm(1000, 10, 10)
num_var_5 <- rnorm(1000, 10, 10)

factor_1 <- c("A","B", "C")
factor_2 <- c("AA","BB", "CC")
factor_3 <- c("AAA","BBB", "CCC", "DDD")
factor_4 <- c("AAAA","BBBB", "CCCC", "DDDD", "EEEE")
factor_5 <- c("AAAAA","BBBBB", "CCCCC", "DDDDD", "EEEEE", "FFFFFF")

factor_var_1 <- as.factor(sample(factor_1, 1000, replace=TRUE, prob=c(0.3, 0.5, 0.2)))
factor_var_2 <-  as.factor(sample(factor_2, 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2)))
factor_var_3 <-  as.factor(sample(factor_3, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.2, 0.1)))
factor_var_4 <-  as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
factor_var_5 <-  as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.3, 0.2, 0.1, 0.1, 0.1)))

id = 1:1000

my_data = data.frame(id,num_var_1, num_var_2, num_var_3, num_var_4, num_var_5, factor_var_1, factor_var_2, factor_var_3, factor_var_4, factor_var_5)


> head(my_data)
  id num_var_1 num_var_2 num_var_3 num_var_4  num_var_5 factor_var_1 factor_var_2 factor_var_3 factor_var_4 factor_var_5
1  1  9.439524  5.021006  4.883963  8.496925  11.965498            B           AA          AAA         CCCC         AAAA
2  2  9.769823  4.800225 12.369379  6.722429  16.501132            B           AA          AAA         AAAA         AAAA
3  3 11.558708  9.910099  4.584108 -4.481653  16.710042            C           AA          BBB         AAAA         CCCC
4  4 10.070508  9.339124 22.192276  3.027154  -2.841578            B           CC          DDD         BBBB         AAAA
5  5 10.129288 -2.746714 11.741359 35.984902 -10.261096            B           AA          AAA         DDDD         DDDD
6  6 11.715065 15.202867  3.847317  9.625850  32.053261            B           AA          CCC         BBBB         EEEE

My Question: I am interested in selecting a random number of variables from this data - and taking random subsets from these variables. (And then repeating this process many times). For example - I would like to record such a randomly generated list:

Iteration 1: num_var_2 > 12, factor_var_1 = "A, C", factor_var_4 = "BBBB, DDDD, EEEE"
Iteration 2: num_var_1 >0, num_var_3 <10, factor_var_2 = "AA, BB, CC", factor_var_3 = "AAA", factor_var_5 = "CCCCC, DDDDD"
Iteration 3: num_var_2 <5, num_var_5 <10, factor_var_1 = "B", factor_var_3 = "AAA"
Iteration 4 : factor_var_4 = "BBBB"

etc.

I can perform the above manually, but this would take a long time (e.g. 10 iterations). Is there a way to automate this process and in the end, just output this kind of list (10 rows × 2 columns) :

Iteration                                                                                                  Condition
1                                               num_var_2 > 12, factor_var_1 = A, C, factor_var_4 = BBBB, DDDD, EEEE
2            num_var_1 >0, num_var_3 <10, factor_var_2 = AA, BB, CC, factor_var_3 = AAA, factor_var_5 = CCCCC, DDDDD
3                                                  num_var_2 <5, num_var_5 <10, factor_var_1 = B, factor_var_3 = AAA
4                                                                                                factor_var_4 = BBBB

Can someone please show me how to do this?

ekoam · Accepted Answer

As far as I understand, for a factor or a character vector, we need a function to randomly decide a sample size and then a random sample out of some data points. For a numeric vector, we need a function to randomly decide a cutoff between the minimum and maximum and whether to pick numbers greater or smaller than that cutoff point. Finally, we need to summarize the rules based on the formats provided in this post.

Consider the following function for factors and characters. It first decides a random sample size based on the number of items in x and then randomly samples items from x.

random_pick <- function(x) {
  sample_size <- sample.int(length(x), 1L)
  out <- x[sort(sample.int(length(x), sample_size))]
  list("=", out)
}

Also, consider a function like this for numerics. It finds the min/max, determines the cutoff, and the sign for comparison.

random_trunc <- function(x) {
  rng <- range(x)
  cutoff <- runif(1L, rng[[1L]], rng[[2L]])
  sgn <- c("<", ">")[[sample.int(2L, 1L)]]
  list(sgn, cutoff)
}

Then, we assemble these two functions together for your specific case. Note that for characters we only need to pick the unique ones.

random_select <- function(x) {
  if (is.numeric(x))
    return(random_trunc(x))
  if (is.factor(x))
    return(random_pick(levels(x)))
  random_pick(unique(x))
}

report generates the rules we want based on the formats provided.

report <- function(f) function(...) {
  x <- f(...)
  if (x[[1L]] != "=")
    return(sprintf("%s %.2f", x[[1L]], x[[2L]]))
  sprintf("%s \"%s\"", x[[1L]], paste0(x[[2L]], collapse = ", "))
}

Now we are ready to write our function for randomly generating rules from a dataset. The idea is to first randomly select from all variables (except for the first one id), then apply random_rule to each selected, and finally summarize the results.

random_rule <- function(dt) {
  out <- vapply(
    dt[random_pick(names(dt)[-1L])[[2L]]], 
    report(random_select), character(1L)
  )
  paste(names(out), out, collapse = ", ")
}

As a result, we can simply do this for as many iterations as needed

set.seed(123)
data.frame(iteration = 1:10, results = replicate(10L, random_rule(my_data)))

Results

> set.seed(123)
> data.frame(iteration = 1:10, records = replicate(10L, random_rule(my_data)))
   iteration
1          1
2          2
3          3
4          4
5          5
6          6
7          7
8          8
9          9
10        10
                                                                                                                                                                                                                                                  records
1                                                                                                                                                                                             num_var_2 < 12.51, num_var_3 > 41.50, factor_var_1 = "A, B"
2                                                                                                                                         num_var_1 < 11.16, num_var_3 > 15.63, num_var_4 > -3.87, factor_var_2 = "BB", factor_var_4 = "AAAA, BBBB, DDDD"
3                                                                                                          num_var_1 < 9.87, num_var_2 < -1.32, num_var_3 > -5.54, num_var_4 > 24.09, num_var_5 < 3.28, factor_var_2 = "AA, BB, CC", factor_var_3 = "CCC"
4                                                        num_var_1 > 9.72, num_var_2 > -1.93, num_var_3 < 43.27, num_var_4 < 32.11, num_var_5 > -12.77, factor_var_1 = "B", factor_var_2 = "AA", factor_var_4 = "AAAA, BBBB, DDDD", factor_var_5 = "AAAA"
5                                                                                           num_var_1 > 10.51, num_var_2 > 13.61, num_var_3 > 22.14, num_var_4 < -2.75, factor_var_1 = "A, B, C", factor_var_3 = "AAA", factor_var_4 = "BBBB, DDDD, EEEE"
6                                                                                                                                                                                             factor_var_1 = "A, B, C", factor_var_5 = "BBBB, CCCC, EEEE"
7                                                                         num_var_1 > 9.34, num_var_2 < 18.59, num_var_3 < 7.39, num_var_4 > 16.66, num_var_5 > 35.48, factor_var_1 = "C", factor_var_2 = "AA, BB, CC", factor_var_4 = "AAAA, BBBB, CCCC"
8  num_var_1 > 10.66, num_var_2 > 25.74, num_var_3 > 13.81, num_var_4 > 31.73, num_var_5 > -2.40, factor_var_1 = "A, B, C", factor_var_2 = "AA, BB", factor_var_3 = "AAA, CCC, DDD", factor_var_4 = "AAAA, BBBB, CCCC, DDDD, EEEE", factor_var_5 = "DDDD"
9   num_var_1 < 10.78, num_var_2 < 11.86, num_var_3 < -7.95, num_var_4 < 7.12, num_var_5 > 39.57, factor_var_1 = "A, B, C", factor_var_2 = "AA, BB, CC", factor_var_3 = "CCC", factor_var_4 = "BBBB, EEEE", factor_var_5 = "AAAA, BBBB, CCCC, DDDD, EEEE"
10                                                                                                num_var_1 < 7.63, num_var_2 > 19.04, num_var_4 > 37.87, num_var_5 < -14.85, factor_var_1 = "A, B", factor_var_2 = "AA, CC", factor_var_4 = "AAAA, CCCC"

Put everything together

random_pick <- function(x) {
  sample_size <- sample.int(length(x), 1L)
  out <- x[sort(sample.int(length(x), sample_size))]
  list("=", out)
}

random_trunc <- function(x) {
  rng <- range(x)
  cutoff <- runif(1L, rng[[1L]], rng[[2L]])
  sgn <- c("<", ">")[[sample.int(2L, 1L)]]
  list(sgn, cutoff)
}

random_select <- function(x) {
  if (is.numeric(x))
    return(random_trunc(x))
  if (is.factor(x))
    return(random_pick(levels(x)))
  random_pick(unique(x))
}

report <- function(f) function(...) {
  x <- f(...)
  if (x[[1L]] != "=")
    return(sprintf("%s %.2f", x[[1L]], x[[2L]]))
  sprintf("%s \"%s\"", x[[1L]], paste0(x[[2L]], collapse = ", "))
}

random_rule <- function(dt) {
  out <- vapply(
    dt[random_pick(names(dt)[-1L])[[2L]]], 
    report(random_select), character(1L)
  )
  paste(names(out), out, collapse = ", ")
}

set.seed(123)
data.frame(iteration = 1:10, records = replicate(10L, random_rule(my_data)))

Simulating Random Draws From a "Hat"

Answers (2)

Gives

Related Questions

Simulating Random Draws From a &quot;Hat&quot;

Answers (2)

Gives

Related Questions

Simulating Random Draws From a "Hat"