r - for 循环和跨数据集子集的替代方法。 (..使用高阶函数或替代数据结构)

Question

我在 R 中运行离散事件模拟。我算法的“核心”执行以下操作(伪代码):

1) Iterate over events

a) Change event[i] depending on resources

b) Change resources depending on outcome of step a)

以下可重现的示例捕获了主要方面:

生成一些数据:

set.seed(4)
n <- 3
nr_resources <- 2

events <- data.frame(
  t = as.integer(trunc(cumsum(rexp(n)))),
  resource = NA,
  worktime = as.integer(trunc(runif(n)*10))
)

resources <- data.frame(
  id = 1:nr_resources,
  t_free = 0L
)
events
resources

# > events
# t resource worktime
# 0       NA        2
# 4       NA        8
# 5       NA        2
# > resources
# id t_free
#  1      0
#  2      0

现在我们可以模拟资源的调度了:

for (i in 1:n) {
  events$resource[i] <- resources$id[resources$t_free <= events$t[i]][1]
  resources$t_free[events$resource[i]] <- events$t[i] + events$worktime[i]
}

events
resources

# > events
# t resource worktime
# 0        1        2
# 4        1        8
# 5        2        2
# > resources
# id t_free
#  1     12
#  2      7

这种方法工作正常，但有许多缺点我想消除。由于 events 和 resources 被分成两个数据集，因此在这两个数据集中进行了相当多的子集(搜索和替换)。这不是真正可读的。而在实际应用中甚至成为性能瓶颈。 (..当然，真实的例子要复杂得多..)

因此我问自己在 R 中是否有更好的方法来完成这个任务。

我想过用一个普通的高阶函数代替 for 循环，但没有得到任何结果。

• 典型的 R lapply 方法不起作用，因为 lapply 不是为输入数据中的这种迭代变化而构建的。 (据我所知..)
• 我的任务看起来有点像Reduce 模式。由于 Reduce(sum, 1:3, accumulate = TRUE) 使用中间结果并保留它们，我认为我可以使用 Reduce 函数但没有获得任何结果。

我也考虑过重组我的数据，但直到现在都没有成功。

我详细尝试了什么

在算法方面:

lapply 的失败方法:

l <- list(events = events, resources = resources)
l <- lapply(l, function(x) {
  l$events$resource <- l$resources$id[l$resources$t_free <= l$events$t][1]
  l$resources$t_free[l$events$resource] <- l$events$t + l$events$worktime
  return(l)
})

l$events
l$resources

结果变成:

# $events
# t resource worktime
# 1 0        1        2
# 2 4        1        8
# 3 5        1        2
# 
# $resources
# id t_free
# 1  1      7
# 2  2      0

对资源的中间更改会丢失，因此总是会预订资源 1。

---

Reduce 的失败方法:

l <- list(events = events, resources = resources)
l <- Reduce(function(l) {
  l$events$resource <- l$resources$id[l$resources$t_free <= l$events$t][1]
  l$resources$t_free[l$events$resource] <- l$events$t + l$events$worktime
  return(l)}, l, accumulate = TRUE)

这失败了

Error in f(init, x[[i]]) : unused argument (x[[i]])

---

在数据方面:

我能想到的另一种方法是更改数据以在一个数据集中表示。例如，将事件乘以资源数量。我尝试了以下方法:

data <- merge(events, resources)
data <- data[order(data$t), ]
data

# t resource worktime id t_free
# 0       NA        2  1      0
# 0       NA        2  2      0
# 4       NA        8  1      0
# 4       NA        8  2      0
# 5       NA        2  1      0
# 5       NA        2  2      0

for (i in seq_along(data)) {
  if ( is.na(data$resource[i])) {
    data$resource[data$t == data$t[i]] <- data$id[data$t_free <= data$t[i]][1]
    data$t_free[data$id == data$resource[i]] <- data$t[i] + data$worktime[i]
  }
}

data
# t resource worktime id t_free
# 0        1        2  1     12
# 0        1        2  2      7
# 4        1        8  1     12
# 4        1        8  2      7
# 5        2        2  1     12
# 5        2        2  2      7

events <- unique(data[,1:3])
events
# t resource worktime
# 0        1        2
# 4        1        8
# 5        2        2

resources <- unique(data[,4:5])
resources
# id t_free
#  1     12
#  2      7

这也有效，但我不确定如果缩放这是否会带来更好的性能、可读性和可变性......

---

所以我的问题是:

在算法或数据方面是否有任何替代方案可以改进我的实际解决方案？

Answer 1

老实说，我更喜欢你的第一个 for 循环，您应该考虑使用类似 Rcpp::sourceCpp 的东西，并将您的逻辑迁移到 C++。我认为这应该是可读的并且更快。如果你必须在 R 中这样做，这是一种可能性:

t_free <- Reduce(x = 1L:n,
                 init = rep(0L, nr_resources),
                 accumulate = TRUE,
                 f = function(t_free, i) {
                   # which.max will return the location of the first TRUE
                   id <- which.max(t_free <= events$t[i])
                   # R makes a local copy of t_free here
                   t_free[id] <- events$t[i] + events$worktime[i]
                   # return the chosen resource for this "iteration"
                   attr(t_free, "resource") <- id
                   # return the modified copy
                   t_free
                 })

# events$resource column by extracting the resource attribute, igonring init
events$resource <- sapply(t_free[-1L], attr, "resource")
# your resources$t_free column in the last element
resources <- data.frame(id = 1L:nr_resources,
                        t_free = t_free[[n + 1L]])