Как автоматически настроить и добавить функции в модель в R?

Question

Я настраиваю модель и пытаюсь уменьшить количество написанного.

Конкретно, я использую R-пакет coala для проведения коалесцентных симуляций, и я пытаюсь легко реализовать ступенчатую модель миграции.

Воспроизводимый пример: 4 линейно распределенных населения обмениваются мигрантами по ступенчатой ​​схеме (только смежные популяции).

model <- coal_model(sample_size = c(5, 5, 5, 5),
                    loci_number = 1,
                    loci_length = 10,
                    ploidy = 1) +
feat_mutation(rate = mut_rate, # e.g. 0.1
              model = "HKY",
              base_frequencies = c(0.25,0.25,0.25,0.25),
              tstv_ratio = 4) +
feat_migration(mig_rate, 1, 2) + # mig_rate can be e.g. 0.5
feat_migration(mig_rate, 2, 1) +
feat_migration(mig_rate, 2, 3) +
feat_migration(mig_rate, 3, 2) +
feat_migration(mig_rate, 3, 4) +
feat_migration(mig_rate, 4, 3) +
sumstat_dna(name = "dna", transformation = identity)

Этот пример работает, но недостатком является то, что мне приходится писать много строк 'feat_migration', хотя есть четкая схема, которую можно автоматизировать. Это хорошо для небольшого числа популяций, но я хочу провести большую симуляцию с около 70 популяциями. У кого-нибудь есть хорошая идея, как это автоматизировать? Документация мне пока не помогла.

Я пробовал две вещи, которые не работали:

feat_migration(mig_rate, c(1,2,2,3,3,4), c(2,1,3,2,4,3))

и что-то вроде этого:

migration_model <- function(){
  for(i in 1:n_pops){
    feat_migration(mig_rate, i, i+1) +
    feat_migration(mig_rate, i+1, i))
}

В последнем случае я действительно не знаю, как правильно создать и разобрать все функции в моей модели.

Хорошие идеи приветствуются! :)

Answer 1

Ответ является небольшим изменением решения, предложенного Parfait. Модель инициализируется без ошибок и может запускаться в симуляторе без ошибок.

n_pops <- 4    
start_pts <- as.vector(sapply(seq(n_pops-1), function(x) c(x, x+1)))  
end_pts <- as.vector(sapply(seq(n_pops-1), function(x) c(x+1, x)))

# LIST OF feat_migration()
feats <- Map(function(x, y) feat_migration(mig_rate, x, y), start_pts, end_pts)

# LIST OF FUNCTIONS
funcs <- c(list(coal_model(sample_size = c(5, 5, 5, 5),
                           loci_number = 1,
                           loci_length = 10,
                           ploidy = 1),
                feat_mutation(rate = mut_rate, # e.g. 0.1
                              model = "HKY",
                              base_frequencies = c(0.25,0.25,0.25,0.25),
                              tstv_ratio = 4),
                sumstat_dna(name = "dna", transformation = identity)),

            feats)
           )

# MODEL CALL     
model <- Reduce(`+`, funcs)

Answer 2

Рассмотрим функции высшего порядка: Map (обертка для mapply) и Reduce для построения списка вызовов функций и итеративного добавления их в модель. В частности, Reduce помогает для накопления функций, когда результат каждой итерации необходимо передать в следующую итерацию, чтобы свести к единому конечному результату.

n_pops <- 4    
start_pts <- as.vector(sapply(seq(n_pops-1), function(x) c(x, x+1)))  
start_pts
# [1] 1 2 2 3 3 4

end_pts <- as.vector(sapply(seq(n_pops-1), function(x) c(x+1, x)))
end_pts
# [1] 2 1 3 2 4 3

# LIST OF feat_migration()
feats <- Map(function(x, y) feat_migration(mig_rate, x, y), start_pts, end_pts)

# LIST OF FUNCTIONS
funcs <- c(coal_model(sample_size = c(5, 5, 5, 5),
                      loci_number = 1,
                      loci_length = 10,
                      ploidy = 1),
           feat_mutation(rate = mut_rate, # e.g. 0.1
                         model = "HKY",
                         base_frequencies = c(0.25,0.25,0.25,0.25),
                         tstv_ratio = 4),
           feats,
           sumstat_dna(name = "dna", transformation = identity)
          )

# MODEL CALL     
model <- Reduce(`+`, funcs)

---

Кроме того, функциональная форма для вызовов ggplot +: Reduce:

gp <- ggplot(df) + aes_string(x='Time', y='Data') +
        geom_point() + scale_x_datetime(limits=date_range)

# EQUIVALENTLY
gp <- Reduce(ggplot2:::`+.gg`, list(ggplot(df), aes_string(x='Time', y='Data'), 
                                    geom_point(), scale_x_datetime(limits=date_range)))