Сократить аргументы функции в вектор - PullRequest
0 голосов
/ 20 марта 2019

Здравствуйте, я моделирую из функции, определенной с дюжиной аргументов:

library(tidyverse)

rmixexp <- function(n, w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, m1, m2, 
m3, m4, m5, m6, m7, m8, m9, m10, m11) {
  w1 * rexp(n, 1 / m1) +
    w2 * rexp(n, 1 / m2) +
    w3 * rexp(n, 1 / m2) +
    w4 * rexp(n, 1 / m5) +
    w5 * rexp(n, 1 / m5) +
    w6 * rexp(n, 1 / m6) +
    w7 * rexp(n, 1 / m7) +
    w8 * rexp(n, 1 / m8) +
    w9 * rexp(n, 1 / m9) +
    w10 * rexp(n, 1 / m10) +
    w11 * rexp(n, 1 / m11)
  }

datatibble <- tibble(
  w1 = c(1/11, 1/11),
  w2 = c(1/11, 1/11),
  w3 = c(1/11, 1/11),
  w4 = c(1/11, 1/11),
  w5 = c(1/11, 1/11),
  w6 = c(1/11, 1/11),
  w7 = c(1/11, 1/11),
  w8 = c(1/11, 1/11),
  w9 = c(1/11, 1/11),
  w10 = c(1/11, 1/11),
  w11 = c(1/11, 1/11),
  m1 = c(1/11, 1/11),
  m2 = c(1/11, 1/11),
  m3 = c(1/11, 1/11),
  m4 = c(1/11, 1/11),
  m5 = c(1/11, 1/11),
  m6 = c(1/11, 1/11),
  m7 = c(1/11, 1/11),
  m8 = c(1/11, 1/11),
  m9 = c(1/11, 1/11),
  m10 = c(1/11, 1/11),
  m11 = c(1/11, 1/11)
  )

Это приводит к громоздкой функции следующим образом:

Имитация из функции ...

n <- 10

loss.test <- datatibble %>% mutate(severity = 
                                       pmap(
                                         list(n, w1, w2, w3, w4, w5, 
                                              w6, w7, w8, w9, w10, w11, 
                                              m1, m2, m3, m4, m5, 
                                              m6, m7, m8, m9, m10, m11),
                                            function(n, w1, w2, w3, w4, w5, 
                                                     w6, w7, w8, w9, w10, w11, 
                                                     m1, m2, m3, m4, m5, 
                                                     m6, m7, m8, m9, m10, m11) 
                                              rmixexp(n, w1, w2, w3, w4, w5, 
                                                      w6, w7, w8, w9, w10, w11, 
                                                      m1, m2, m3, m4, m5, 
                                                      m6, m7, m8, m9, m10, m11))
                                    ) %>%
  mutate(severity = map(severity, ~ data.frame(severity = .x, 
                                                      sim = seq_along(.x))))     %>% 
unnest() %>% select(sim, severity)

Есть ли способ, которым я могу изменить функцию, чтобы принимать фиксированный ряд аргументов вместо определения каждой переменной в отдельности? Также можно ли определить саму функцию как сумму весов и функций rexp?

Спасибо.

1 Ответ

1 голос
/ 20 марта 2019

Если w и m имеют одинаковую длину, одно решение состоит в том, чтобы предоставить их в виде списка и выполнить суммирование, просматривая каждый элемент:

rmixexp <- function(n, w, m) {
    ## Results placeholder
    result <- 0

    ## Loop through w and m
    for(element in 1:length(w)) {
        result <- result + w[[element]] * rexp(n, 1 / m[[element]])
    }

    return(result)
}

Это также будет работать, если w или m являются векторами (тогда вы можете просмотреть w[element] и т. Д.

Кроме того, вы можете использовать функцию mapply, чтобы напрямую применить одну и ту же функцию к обоим спискам:

rmixexp <- function(n, w, m) {
    ## Using mapply to go through both lists (same length)
    mapply.fun <- function(w, m) {w * rexp(n, 1 / m)}

    ## Summing up the result of each function
    result <- sum(unlist(mapply(mapply.fun, w, m))))

    return(result)
}

Надеюсь, это ответит на ваш вопрос.

...