在R中存储模拟功能输出的频率计数

时间:2014-10-13 04:47:56

标签: r data-structures simulation

我有一个程序,我正在为大量迭代运行模拟函数。然而,我仍然坚持我最期望的部分:找出如何存储函数结果的频率计数。

模拟函数本身很复杂,但类似于R sample()函数。大量数据进入,函数输出包含元素子集的向量。

x <- c("red", "blue", "yellow", "orange", "green", "black", "white", "pink")

run_simulation <- function(input_data, iterations = 100){
  for (i in 1:iterations){
    result <- sample(input_data, 3, replace=FALSE)
    results <- ????
  }
}

run_simulation(x)

我的问题是什么是最好的(最有效和类似R)数据结构,用于存储模拟循环内函数结果的频率计数。正如你可以从for循环中看到的那样,我的背景是像Python这样的语言,我会创建一个由元组键入的dict,每次输出特定组合时都会递增:

counts[results_tuple] = counts.get(results_tuple, 0) + 1

但是,R中没有等效的dict / hashmap类型结构,而且我经常发现尝试在R中模拟其他语言是一种丑陋且低效的代码。 (现在我正在将输出向量转换为字符串并将其附加到我稍后使用table()计算的结果列表中,但对于具有有限数字的函数进行大量迭代,这是非常低效的内存可能的输出向量。)

要清楚,这是我想要的输出:

               Result Freq
   black, pink, green    8
     blue, red, white    7
    black, pink, blue    7
   blue, green, black    5
     blue, green, red    4
   green, blue, white    3
   pink, green, white    3
   white, blue, green    1
   white, orange, red    1
yellow, black, orange    1
  yellow, blue, green    1

我不关心任何特定元素的频率,只关心集合。而且我不关心输出的顺序,只关心频率。

感谢任何建议!

3 个答案:

答案 0 :(得分:1)

您可以使用data.table(juiced-up data.frame实现)将可能的值用作关键字。它们需要特定的语法,但效率很高。

以下是我将如何进行的。将模拟输出匹配回索引需要对其进行排序,因此我将其保存在一个新变量下:

require(data.table)

x <- c("red", "blue", "yellow", "orange", "green", "black", "white", "pink")

run_simulation <- function(input_data, iterations = 100){

  # generate set of all possible outputs
  possible_values <- sort(input_data)  ## needed to match simulations

  # combn() seems to preserve input order
  # have to sort each column from combn() output if this is not guaranteed
  results <- as.data.table(t(combn(possible_values, 3)))
  setnames(results, c("first", "second", "third"))
  results[, count:=0]  ## initiate counts column
  setkey(results, first, second, third)  ## use index columns as table key

  for (i in 1:iterations){
    result <- sample(input_data, 3, replace=FALSE)
    result_sorted <- t(sort(result))  ## t() needed to specify it's a row
    colnames(result_sorted) <- c('first', 'second', 'third')
    result_sorted <- as.data.table(result_sorted)
    results[result_sorted, count:=count + 1]
  }
  return(results)
}

生成后的大多数行都需要将向量设置为data.table的正确格式以查找正确的行。对于少数可能的组合,这可能是过度的,但如果可能的组合更大,则应该支付股息。

答案 1 :(得分:1)

以下是使用基本R的简短解决方案,它似乎可以提供相当快的执行时间。

 run_simulation <- function(input_data, iterations = 100){
 Results  <-  replicate(iterations, paste0(sort(sample(input_data, 3, replace=FALSE)),collapse=", ")  )
 results <- as.data.frame(table(Results) )
 }

run_simulation(x)给出

                  Results Freq
 1     black, blue, green    2
 2    black, blue, orange    2
 3      black, blue, pink    6
 4       black, blue, red    6
 5     black, blue, white    2
 6   black, green, orange    3
 7     black, green, pink    1
 8      black, green, red    1

对100,1,000,10,000和100,000次迭代进行基准测试表明,时间随迭代次数呈线性增加,这似乎是可取的。此外,100,000次迭代的总时间约为2,200毫秒或2.2秒。您使用大量数据将模拟描述为复杂,因此很可能模拟的总时间明显超过了将这些代码列入表格所花费的时间。

 library(microbenchmark)

 microbenchmark(run_simulation(x,iterations=100), run_simulation(x,iterations=1000), run_simulation(x,iterations=10000), run_simulation(x,iterations=100000), times=100)

 Unit: milliseconds
                                   expr         min          lq      median          uq        max neval
    run_simulation(x, iterations = 100)    2.352262    2.447647    2.488282    2.573545   71.96314   100
    run_simulation(x, iterations = 1000)   19.161997   19.751702   20.476572   24.411885   90.42650   100
    run_simulation(x, iterations = 10000)  193.688216  208.453087  217.130138  226.166201  289.13177   100
    run_simulation(x, iterations = 1e+05) 2012.773904 2125.986609 2169.870885 2236.038487 2426.02379   100

答案 2 :(得分:1)

您还可以使用environment(实际上使用哈希表)。通过这种方式,您无需枚举模拟的所有结果,因为您无论如何只对计数感兴趣:

runSimulation <- function(input.size = 300L, iterations = 100L) {
   x <- paste0("E", 1L:input.size)
   results <- new.env(hash = TRUE)
   for (i in 1:iterations){
      result <- sample(x, 3, replace = FALSE)
      nam <- paste0(sort(result), collapse = ".")
      if (exists(nam, results)) {
         results[[nam]] <- results[[nam]] + 1
      } else {
         assign(nam, 1, envir = results)
      }
   }
   l <- as.list(results)
   d <- data.frame(tuple = names(l), count = unlist(l))
   rownames(d) <- NULL
   d
}

但是,时间上这与使用table的解决方案相当。