1

I am made a Bayesian belief network and I want to make this available using Shiny, so anyone can use it by just changing some variables. However the shiny app fails to update my function when I modify the inputs. and the output main panel always give 0. How do I need to modify my function in order to be reactive to the new inputs?I have tried retrofit other answers to this problem but I cannot pin point the issue.

I know the BBN works, and the main panel update correctly if I place one of the reactive inputs instead of the function. also if the function has some default values instead of reactive variables, the answer is correctly displayed on the main panel. This is iteration of the code I used, which I believe being the closer to the right outcome

library(bnlearn)
library(shiny)

basic BBN deisgn, saved as script but just for semplicity it is here.

net <- model2network("[Algae][Organic][OxygenConsumption|Algae:Organic]") plot(net)

dg <- c("high", "Mid", "low")
oo=c("good", "fluctuating","hypo")
ss=c("hyper", "marine","hypo","fresh")
ff=c("costant", "seasonal")
cptAlgae = matrix(c(0.33, 0.33,0.34), ncol=3, dimnames=list(NULL, dg))
cptOrganic = matrix(c(0.33, 0.33,0.34), ncol=3, dimnames=list(NULL, dg))

cptOxygenConsumption = c(1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1) 

dim(cptOxygenConsumption) = c(3, 3,3)
dimnames(cptOxygenConsumption) = list("OxygenConsumption"=dg, "Organic"=dg, "Algae"=dg)

net.disc <- custom.fit(net, dist=list(Algae=cptAlgae, Organic=cptOrganic, OxygenConsumption=cptOxygenConsumption))

Shiny App starts here

ui <- fluidPage(
  titlePanel("Test BBN"),

  sidebarLayout(
    sidebarPanel(
      helpText("Enter the pool characteristics"),

      selectInput( inputId ="Algae",
                  label= "Choose Algae Cover",
                  choices = dg,
                  selected = "high"),
      selectInput(inputId = "Organic",
                  label = "Choose Organic matter cover",
                  choices = dg,
                  selected = "high")),
     mainPanel(
                    textOutput("habitability"))
    )
    )
    server <- function(input, output, session) {

      a= reactive({
        input$Algae

      })
      b=reactive({
        input$Organic
      })


      C1= reactive({cpquery(net.disc, (OxygenConsumption =="low"), Algae=="a()" & Organic== "b()")

      })






      output$habitability = reactive({print(C1())})

    }


    shinyApp(ui = ui, server = server)

I expect to have the output resemble a value that goes between 0 and 1, based on the 2 inputs ( it should be 1 if both are "low" and 0 if both are "high".

Brick_C
  • 13
  • 3

1 Answers1

0

I managed to build the query, and evaluate it. Maybe this will help get you started.

library(bnlearn)
library(shiny)

net <- model2network("[Algae][Organic][OxygenConsumption|Algae:Organic]")
plot(net)

dg <- c("high", "mid", "low")
oo <- c("good", "fluctuating", "hypo")
ss <- c("hyper", "marine", "hypo", "fresh")
ff <- c("costant", "seasonal")
cptAlgae <- matrix(c(0.33, 0.33, 0.34), ncol = 3, dimnames = list(NULL, dg))
cptOrganic <- matrix(c(0.33, 0.33, 0.34), ncol = 3, dimnames = list(NULL, dg))
cptOxygenConsumption <- c(1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1)

dim(cptOxygenConsumption) <- c(3, 3, 3)
dimnames(cptOxygenConsumption) <- list("OxygenConsumption" = dg, "Organic" = dg, "Algae" = dg)

net.disc <- custom.fit(net, dist = list(Algae = cptAlgae, Organic = cptOrganic, OxygenConsumption = cptOxygenConsumption))

cpquery(net.disc, (OxygenConsumption == "low"), Algae == "low" & Organic == "low") # ?

ui <- fluidPage(
  titlePanel("Test BBN"),
  sidebarLayout(
    sidebarPanel(
      helpText("Enter the pool characteristics"),
      selectInput(
        inputId = "Algae",
        label = "Choose Algae Cover",
        choices = dg,
        selected = "high"
      ),
      selectInput(
        inputId = "Organic",
        label = "Choose Organic matter cover",
        choices = dg,
        selected = "high"
      )
    ),
    mainPanel(
      textOutput("habitability")
    )
  )
)

server <- function(input, output, session) {

  output$habitability <- renderText({
    req(input$Algae, input$Organic)
    text <- paste0("cpquery(net.disc, (OxygenConsumption == 'low'), Algae == '", input$Algae, "' & Organic == '", input$Organic, "')")
    eval(parse(text=text))
  })

}

shinyApp(ui = ui, server = server)
Simon Woodward
  • 1,946
  • 1
  • 16
  • 24
  • 1
    Thanks Simon, and also for the previous comments, very useful for future reference and this really give me a great starting point!!! – Brick_C Sep 18 '19 at 01:07
  • In shiny you generally have things like xxxxOutput in the ui and renderXxxx in the server. – Simon Woodward Sep 18 '19 at 01:14