如何从 bnlearn 库更改 class bn.fit (bn.fit.dnet) 对象中的概率 table？

Question

我尝试从 R 的 bnlearn 库中修改 class bn.fit (bn.fit.dnet) 的对象。我需要

为 bn.fit$node$prob table 中的每一行设置相等的概率。为此，我使用下一个代码：

library(bnlearn)
library(purrr)

data(insurance)

bn <- tabu(insurance, score = "bic")
bn_fit <- bn.fit(bn, insurance, method = 'bayes')

bn_fit[1:length(bn_fit)] <- modify(bn_fit[1:length(bn_fit)], function(node) {
  node$prob <- modify(node$prob, ~(1 / NROW(node$prob)))
  node
})

我想这种方法有点难看，几乎可以肯定存在更优雅的方法来做到这一点。我无法删除 1:length(bn_fit)。另外我不知道为什么我不能在我的代码中使用 NROW(.x) 而不是 NROW(node$prob)。

在 bn.fit$node$prob table 中的每个列上设置任意分布。我不明白在这种情况下如何避免 for 循环。

相关问题是here

Answer 1

关于 (1)，modify 需要 list 或 atomic vector。 bn_fit 属于 class bn.fit, bn.fit.dnet，但是，在幕后它也是 list，因为调用 typeof() 会产生 list。我的猜测是没有用于子集这些 classes 的 S3 通用方法，因此 R 发现它本质上是一个 list 并相应地去除 class 参数。因此子集 bn_fit 将其变成 class list，因此您可以在其上使用 modify。子集甚至可以用空括号 [] 完成，它只会 return 对象，但这次是 class list。我在下面使用的替代方法是通过 attr(bnfit, "class") <- NULL.

“手动”将 class 属性设置为 NULL

关于 (2)，我写了一个基于 tidyverse 的函数，它可以用来将每个节点的 prob table 改变为 bayesm::rdirichlet 分布（见下面的代码）。用户仍然需要提供部分 alpha 参数（长度参数由每个概率 table 的长度给出）。在幕后，该功能依赖于 purrr::modify。它通过首先剥离它们并在修改完成后将它们添加回去来处理 classes 。我的方法是将概率 tables 转换为 data.frames，然后修改 Freq 列并针对现有的其他变量（组）进行调整，然后将 data.frame 转换回a table 使用 xtabs 和公式符号 reformulate.

我对贝叶斯网络不是很深入，所以我不知道这个函数可以泛化到什么程度，或者它是否只适用于您提供的数据集。此外，请测试修改后的对象是否被期望 class bn.fit, bn.fit.dnet.

的函数接受

我尝试对我的代码的每一步进行评论，但如果有不清楚的地方请询问。

(3) 关于您的问题，为什么 NROW(.x) 在您的代码中不起作用，您必须改用 NROW(node$prob) ：这与 modify 循环的方式有关概率 tables。检查 modify 循环的元素的一个好方法是使用 purrr::pluck.

library(bnlearn)
library(tidyverse)

data(insurance)

bn <- tabu(insurance, score = "bic")
bn_fit <- bn.fit(bn, insurance, method = 'bayes')

change_bn_prob_table <- function(bnfit, alpha) {
  
  # save class attribute of bnfit object
  old_class <- attr(bnfit, "class")
  
  # strip class so that `modify` can be used
  attr(bnfit, "class") <- NULL
  
  # loop over `prop` tables of each node
  new <- purrr::modify(bnfit, function(x) {
    
    # save attributes of x 
    old_x_attr <- attributes(x)
    
    # save attributes of x[["prob"]]
    old_xprob_attr <- attributes(x[["prob"]])
    
    # turn `table` into data.frame
    inp <- as.data.frame(x[["prob"]]) 
    # save names apart from `Freq`
    cnames <- inp %>% select(-Freq) %>% colnames
    
    out <- inp %>% 
      # overwrite column `Freq` with probabilities from bayesm::rdirichlet
      # alpha needs to be supplied (the length of alpha is given by `nrow`)
      mutate(Freq := bayesm::rdirichlet(c(rep(alpha, nrow(inp))))) %>% 
      # devide probilities by sum of Freq in all remaining groups
      group_by(!!! syms(cnames[-1])) %>% 
      mutate(Freq := Freq/sum(Freq)) %>% 
      # turn data.frame back into prob table using formula notation via reformulate
      xtabs(reformulate(paste(colnames(.)), "Freq"), .)
    
    # strip `call` attribute from newly generated prob table
    attr(out, "call") <- NULL  
    # add `class` `table` as attribute
    attr(out, "class") <- "table"
    
    # restore old attribues and write x out to x$prob
    attributes(out) <- old_xprob_attr
    x[["prob"]] <- out
    
    # restore old attribues and return x
    attributes(x) <- old_x_attr
    x
    
  })
  
  # add saved class attributes 
  attr(new, "class") <- old_class
  new
  
}
# here `2` is the first part of `alpha` of `bayesm::rdirichlet`
bn_fit2 <- change_bn_prob_table(bn_fit, 2)

# test that `logLik` can be used on new modified bnfit object 
logLik(bn_fit2, insurance)
#> [1] -717691.8

^{由 reprex package (v0.3.0)}

于 2020-06-21 创建

如何从 bnlearn 库更改 class bn.fit (bn.fit.dnet) 对象中的概率 table？

How to change probability table in object of class bn.fit (bn.fit.dnet) from bnlearn library?

functional-programming

r

purrr

bnlearn