Início / coding / Perguntas / 77588080
Accepted
mr.T
Asked: 2023-12-02 05:08:18 +0800 CST

como iterar rapidamente funções uma por uma

  • 772

eu tenho alguns dados

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)
)

E também tenho uma lista de funções, o número de funções pode ser qualquer, a complexidade das funções também (eu as simplifiquei intencionalmente para este exemplo)

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

A seguir, tenho uma função que busca sequencialmente o acionamento da primeira função, depois da segunda e assim por diante

# 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)
}

Gostaria de acelerar find_rulesa função tanto quanto possível sem alterar nada no código apresentado acima. Gostaria também de identidade completa nos cálculos da sua solução e find_rulesnos diferentesseeds()

1 respostas

  1. Best Answer

    Tentei manter o seu código o máximo possível mas podemos mudar a forma de iterar, ou seja, porrules

    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
}

    que deve ser mais rápido que sua solução original se o número de regras for menor que o número de dflinhas .

    referência

    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"
)

    e vemos isso

    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

relate perguntas