Как изменить таблицу вероятностей в объекте класса bn.fit (bn.fit. dnet) из библиотеки bnlearn? - PullRequest
Новая
       93

Как изменить таблицу вероятностей в объекте класса bn.fit (bn.fit. dnet) из библиотеки bnlearn?

2 голосов
/ 17 июня 2020

Я пытаюсь изменить объект класса bn.fit (bn.fit.dnet) из библиотеки R bnlearn. Мне нужно

  1. , чтобы установить равные вероятности для каждой строки в таблице bn.fit $ node $ prob. Для этого я использую следующий код: 
    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 таблице. Я не понимаю, как избежать циклов for в этом случае.

Связанный вопрос здесь

1 Ответ

1 голос
/ 20 июня 2020

Что касается (1), modify принимает list или atomic vector. bn_fit относится к классу bn.fit, bn.fit.dnet, однако под капотом это тоже list, поскольку вызов typeof() дает list. Я предполагаю, что не существует метода S3 generi c для подмножества этих классов, поэтому R выясняет, что это, по сути, list и, соответственно, удаляет аргументы класса. Таким образом, подмножество bn_fit превращает его в class list, и поэтому вы можете использовать на нем modify. Подмножество может быть выполнено даже с пустыми скобками [], он просто вернет объект, но на этот раз как class list. Альтернативой, которую я использую ниже, является "вручную" установить атрибут class на NULL через attr(bnfit, "class") <- NULL.

Что касается (2), я написал функцию на основе tidyverse, которую можно использовать для измените таблицу prob каждого узла на распределение bayesm::rdirichlet (см. код ниже). Пользователь по-прежнему должен предоставить часть аргумента alpha (аргумент длины задается длиной каждой проблемы table). Под капотом функция полагается на purrr::modify. Он заботится о классах, сначала удаляя их и добавляя обратно после завершения модификации. Мой подход состоит в том, чтобы превратить задачу table s в data.frame s, затем изменить столбец Freq и настроить его для существующих других переменных (групп), а затем преобразовать это data.frame обратно в table, используя xtabs и обозначение формулировки через reformulate.

Я не так глубоко разбираюсь в байесовских сетях, поэтому не знаю, в какой степени эта функция может быть обобщена, и работает ли она только с предоставленным вами набором данных. Кроме того, проверьте, принимается ли измененный объект функциями, ожидающими класса bn.fit, bn.fit.dnet.

Я пытался прокомментировать каждый шаг моего кода, но, пожалуйста, спросите, если что-то не понятно.

( 3) Относительно вашего вопроса, почему NROW(.x) не работает в вашем коде, и вы должны использовать вместо этого NROW (node ​​$ prob): это связано с тем, как modify перебирает prob table s. Хороший способ проверить, какие элементы 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

Создано 21.06.2020 с помощью пакета (v0.3.0)

...