如何在R中自动设置和添加函数？

Posted 2021-04-03

我正在建立一个模型，我正在努力减少我必须做的写作量。

具体来说，我使用coala R-package进行合并模拟，我正在尝试轻松实现踏脚石迁移模型。

一个可重复的例子：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))
}

在后一种情况下，我真的不知道如何正确地创建和解析所有函数到我的模型中。

好主意非常受欢迎！ :)

答案

考虑高阶函数：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)))

另一答案

答案是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)