Question

我正在建立模型，并且试图减少我要做的写作量。

具体来说，我正在使用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))
}

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

非常欢迎好主意！：）

Answer 1

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

Answer 2

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

如何在R中自动设置模型并向模型添加功能？

2 个答案: