闪亮服务器中带有 bnlearn cpquery 的贝叶斯网络问题 - 提供证据答案

【问题标题】：Problem with Bayesian Network with bnlearn cpquery in shiny server - supplying evidence闪亮服务器中带有 bnlearn cpquery 的贝叶斯网络问题 - 提供证据
【发布时间】：2020-01-18 10:28:54
【问题描述】：

我正在使用 bnlearn 构建一个带有贝叶斯网络引擎的 ShinyDashboard 评估工具。它是使用专家知识创建的离散网络来构建条件概率表。闪亮的前端用于引出证据，但是，当我尝试使用 cpquery 在后端应用证据时，它不起作用。如果我在后端闪亮服务器中对证据进行硬编码，它就可以工作。所以我认为这与访问我缺少的输入变量有关。

我尝试了各种格式化 cpquery 证据的方法，但无济于事，正如我所说，尝试了硬编码值，效果很好。

这很好用！

Index <- shiny::reactive({
  cpquery(fitted = tdag,
          event = (A == "High"),              # event
          evidence = ( (B == "Yes") &      # evidence
                       (C == "Medium") &
                       (D == "Medium") &
                       (E == "Yes") &
                       (G == "High") &
                       (H == "Low") 
          ), # end evidence
          n = 1000000,                       # no of samples generated
          debug = TRUE
  ) # end cpqery
}) # end reactive

这不是：

Index <- shiny::reactive({
  # Create a string of the selected evidence
  str1 <<- paste0(
    "(B == '", input$BChoiceInp, "') & ",
    "(C == '", input$CChoiceInp, "') & ",
    "(D == '", input$DChoiceInp, "') & ",
    "(E == '", input$EChoiceInp, "') & ",
    "(G == '", input$GChoiceInp, "') & ",
    "(H == '", input$HChoiceInp, "')"
  )

  cpquery(fitted = tdag,
          event = (A == "High"),              # event
          evidence = (eval(parse(text = str1))),       # evidence
          n = 1000000,                       # no of samples generated
          debug = TRUE
  ) # end cpqery
}) # end reactive

我也试过

str2 = "(A == "'High'")"

eval(parse(text = paste("cpquery(fitted,",str2,",",str1,", n = 100000, debug=TRUE)")))

同样的结果。网络运行但结果如下 - 它似乎没有看到输入。：

* checking which nodes are needed.
  > event involves the following nodes: A
  > evidence involves the following nodes: B C D E G H
  > upper closure is ' A B C D E F G H I J  '
  > generating observations from 10 / 10 nodes.
* generated 10000 samples from the bayesian network.
  > evidence matches 0 samples out of 10000 (p = 0).
  > event matches 0 samples out of 0 (p = 0).
* generated 10000 samples from the bayesian network.
  > evidence matches 0 samples out of 10000 (p = 0).
  > event matches 0 samples out of 0 (p = 0).

这是硬编码证据的结果 - 工作正常：

* generated 10000 samples from the bayesian network.
  > evidence matches 39 samples out of 10000 (p = 0.0039).
  > event matches 30 samples out of 39 (p = 0.7692308).
* generated 10000 samples from the bayesian network.
  > evidence matches 33 samples out of 10000 (p = 0.0033).
  > event matches 21 samples out of 33 (p = 0.6363636).
* generated 10000 samples from the bayesian network.
  > evidence matches 36 samples out of 10000 (p = 0.0036).
  > event matches 23 samples out of 36 (p = 0.6388889).
* generated a grand total of 1e+06 samples.
  > event matches 2666 samples out of 4173 (p = 0.6388689)

嘿嘿！

【问题讨论】：

bnlearn 以编程方式使推理有点棘手，因为它解析事件/证据字符串的方式。 This answer 展示了在函数内部执行此操作的一种方法。通过快速测试，这提供了一种继续进行闪亮的方法，否则 cpquery 很难识别证据。
好的，所以 cpquery 在 Shiny 中不起作用 - 非常感谢您的确认。 ..叹。我的数据集是根据专家知识创建的，而不是通过学习数据集创建的。那么如何让数据集使用这种其他方法呢？
嗨英格丽德；它确实有效。只是您必须使用一些解决方法，例如我链接的问题中的eval(parse(...))。我在聊天室中添加了一个示例：chat.stackoverflow.com/rooms/199619/ingrid。您可能会发现使用cpdist 更容易，因为它以编程方式工作得更好，但意味着如果使用lw 或在cpquery 中使用lw，您必须弄乱采样权重，这在编程上也可以很好地工作9，但范围可以询问的查询减少了（但可能适合您的用例）...
尊敬的 user20650，非常感谢您非常感谢！这对我有用，因为我真的很难过。这种变化就这么简单吗？再次非常感谢！我无法在聊天中回复，因为我显然没有足够的声望点！最好的问候 - 英格丽德

标签： r shinydashboard shiny-server shiny-reactivity bayesian-networks

【解决方案1】：

非常感谢 user20650，解决方案是在整个计算过程中使用 renderText。效果很好。

library(shiny)
library(bnlearn)

tdag = bn.fit(hc(learning.test[5:6]), learning.test[5:6])

shinyApp(

ui = basicPage(
selectInput("e", "E:", choices=letters[1:3] ),
selectInput("f", "F:", choices=letters[1:2] ),
textOutput("prob")
),

server = function(input, output, session) {
output$prob <- renderText({
event <- paste0("(F == '", input$f, "')")
evidence <- paste0("(E == '", input$e, "')")
eval(parse(text=paste(
'cpquery(fitted=tdag,
event = ', event, ',
evidence = ', evidence, ',
n = 100000,
debug = TRUE)'
)))})}
)

【讨论】：