主页 / coding / 问题 / 77588080
Accepted
mr.T
Asked: 2023-12-02 05:08:18 +0800 CST

如何快速迭代函数

  • 772

我有一些数据

set.seed(1)
n <- 100
df <- data.frame(
  x = sample(1:30, n, replace = T),
  y = sample(1:30, n, replace = T),
  z = sample(1:30, n, replace = T)
)

我还有函数列表，函数的数量可以是任意的，函数的复杂性也可以（在这个例子中我故意让它们变得简单）

rules <- list(function(i) df$x[i]==26,
              function(i) df$y[i]==17,
              function(i) df$z[i]==14)

接下来，我有一个函数，它顺序搜索第一个函数的触发，然后是第二个函数，依此类推

# search sequence
# first x[i]==26 then y[i]==17 then z[i]==14
find_rules <- function(df, rules){
ln <- length(rules)
n <- 1
res <- matrix(0,nrow = ln, ncol = 2, dimnames = list(NULL, c("row","res")))
for(i in 1:nrow(df)){
  if(rules[[n]](i)){
    res[n,"row"] <- i
    res[n,"res"] <- 1
    n <- n+1
  }
  if(n==ln+1) break
}
return(res)
}

我想 find_rules在不改变上面代码中任何内容的情况下尽可能地加速功能。我还想在您的解决方案的计算中以及find_rules不同的情况下获得完整的身份seeds()

1 个回答

  1. Best Answer

    我试图尽可能保留你的代码，但我们可以改变迭代的方式，即，rules

    find_rules_TIC <- function(df, rules) {
    res <- matrix(0, nrow = length(rules), ncol = 2, dimnames = list(NULL, c("row", "res")))
    rid <- seq_len(nrow(df))
    for (i in seq_along(rules)) {
        k <- which(rules[[i]](rid))
        res[i, "row"] <- k[k >= res[ifelse(i == 1, 1, i - 1), "row"]][1]
        res[i, "res"] <- 1
    }
    res
}

    如果规则数小于df行数，这应该比原始解决方案更快。

    基准

    find_rules_mrT <- function(df, rules) {
    ln <- length(rules)
    n <- 1
    res <- matrix(0, nrow = ln, ncol = 2, dimnames = list(NULL, c("row", "res")))
    for (i in 1:nrow(df)) {
        if (rules[[n]](i)) {
            res[n, "row"] <- i
            res[n, "res"] <- 1
            n <- n + 1
        }
        if (n == ln + 1) break
    }
    return(res)
}

find_rules_TIC <- function(df, rules) {
    res <- matrix(0, nrow = length(rules), ncol = 2, dimnames = list(NULL, c("row", "res")))
    rid <- seq_len(nrow(df))
    for (i in seq_along(rules)) {
        k <- which(rules[[i]](rid))
        res[i, "row"] <- k[k >= res[ifelse(i == 1, 1, i - 1), "row"]][1]
        res[i, "res"] <- 1
    }
    res
}

find_rules_TIC2 <- function(df, rules) {
    rid <- seq_len(nrow(df))
    cbind(
        row = Reduce(\(a, b) b[b >= a][1],
            lapply(rules, \(f) which(f(rid))),
            init = -Inf,
            accumulate = TRUE
        )[-1],
        res = 1
    )
}

microbenchmark(
    find_rules_mrT(df, rules),
    find_rules_TIC(df, rules),
    find_rules_TIC2(df, rules),
    check = "equal",
    unit = "relative"
)

    我们看到

    Unit: relative
                       expr      min       lq     mean   median       uq
  find_rules_mrT(df, rules) 3.825137 3.710938 3.420265 3.628788 3.462264
  find_rules_TIC(df, rules) 1.000000 1.000000 1.000000 1.000000 1.000000
 find_rules_TIC2(df, rules) 1.098361 1.093750 3.288799 1.093434 1.127358
      max neval
  2.89117   100
  1.00000   100
 99.19507   100
    • 1

相关问题