## ----setup, include = FALSE--------------------------------------------------- # # devtools::load_all(".") # only used in place of dst when testing with R-devel. # attach package dst library(dst) # knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----------------------------------------------------------------------------- # 1. define the tt matrix MHABC_tt, which encodes the subset S # MHABC_tt <- matrix(c(1,0,0,0,1,0,0,0,1, 1,0,0,0,0,1,0,1,0, 0,1,0,1,0,0,0,0,1, 0,1,0,0,0,1,1,0,0, 0,0,1,1,0,0,0,1,0, 0,0,1,0,1,0,1,0,0, rep(1,9)), ncol=9, byrow=TRUE) colnames(MHABC_tt) <- rep(c("car", "goat1", "goat2"), 3) # # 2. define the spec matrix. # Here we have one subset of six elements # MHABC_spec = matrix(c(rep(1,6),2,rep(1,6),0), ncol = 2, dimnames = list(NULL, c("specnb", "mass"))) # # 3. define the info matrix. # for each variable, we attribute a number and give the size of the frame # MHABC_info =matrix(c(1:3, rep(3,3)), ncol = 2, dimnames = list(NULL, c("varnb", "size")) ) # # 4. call of the function with the name of the variables and the numbering of the relation # MHABC_rel <- bcaRel(tt = MHABC_tt, spec = MHABC_spec, infovar = MHABC_info, varnames = c("MHA", "MHB", "MHC"), relnb = 1) # # Relation vetween the three doors A, B and C bcaPrint(MHABC_rel) # Note that row labels can become pretty long. If it is the case, the prmatrix function can be used to view results, for example: # # prmatrix(t(MHABC_rel$tt), collab = "") # # Another way to check the tt matrix is: # # which(MHABC_rel$tt[1,] == TRUE) ## ----------------------------------------------------------------------------- # Evidence related to choice of door A MHA_E <- bca(tt= diag(1,3,3), m= rep(1/3, 3), cnames =c("car", "goat1", "goat2"), varnames = "MHA", idvar = 1) # Evidence of the contestant (function MHA_E attached to variable A) bcaPrint(MHA_E) ## ----------------------------------------------------------------------------- # Evidence for door B MHB_E <- bca(tt= matrix(c(0,1,1), ncol=3, byrow = TRUE), m=1, cnames =c("car", "goat1", "goat2"), varnames = "MHB" , idvar=2) # Evidence added by the Host (function MHB_E attached to variable B) bcaPrint(MHB_E) ## ----fig.show='hold', fig_caption: yes, echo=FALSE, message=FALSE------------- # The network if (requireNamespace("igraph", quietly = TRUE) ) { library(igraph) # Encode pieces of evidence and relations with an incidence matrix Monty_hgm <- matrix(c(1,1,1,1,0,0,0,1,0), ncol=3, dimnames = list(c("A", "B", "C"), c("r_ABC", "ev_A", "ev_B"))) # The graph structure Monty_hg <- graph_from_biadjacency_matrix(incidence = Monty_hgm, directed = FALSE, multiple = FALSE, weighted = NULL,add.names = NULL) V(Monty_hg) # Show variables as circles, relations and evidence as rectangles V(Monty_hg)$shape <- c("circle", "crectangle")[V(Monty_hg)$type+1] V(Monty_hg)$label.cex <- 0.6 V(Monty_hg)$label.font <- 2 # render graph plot(Monty_hg, vertex.label = V(Monty_hg)$name, vertex.size=(4+4*V(Monty_hg)$type)*8) } ## ----------------------------------------------------------------------------- # 1. Extend MHA to the product space A x B x C MHA_ext <- extmin(MHA_E, MHABC_rel ) "Evidence of Contestant extended to the product space A x B x C" bcaPrint(MHA_ext) # # 2. Combine MHA_ext and MHABC_rel MHA_ABC_comb <- dsrwon(MHA_ext,MHABC_rel) # since the measure of contradiction is 0, no need to normalize MHA_ABC_comb$con # "Subsets resulting from the combination of Expert 1 extended and r1" bcaPrint(MHA_ABC_comb) # # 3. Eliminate variable A MHBC <- elim(MHA_ABC_comb, xnb = 1) bcaPrint(MHBC) ## ----echo=FALSE--------------------------------------------------------------- # {r, fig.show='hold', fig_caption: yes, echo=FALSE, message=FALSE} Monty2_hgm <- matrix(c(1,1,1,0), ncol=2, dimnames = list(c("B", "C"), c("r_BC", "ev_B"))) Monty2_hg <- graph_from_biadjacency_matrix(incidence = Monty2_hgm, directed = FALSE, multiple = FALSE, weighted = NULL,add.names = NULL) V(Monty2_hg) # Variables as circles, relations and evidence as rectangles V(Monty2_hg)$shape <- c("circle","crectangle")[V(Monty2_hg)$type+1] V(Monty2_hg)$label.cex <- 0.6 V(Monty2_hg)$label.font <- 2 # render graph # plot(Monty_hg, vertex.size=40) plot(Monty2_hg, vertex.label = V(Monty2_hg)$name, vertex.size=(4+4*V(Monty2_hg)$type)*8) ## ----------------------------------------------------------------------------- # 1. Extend MHB_E to the space B x C MHB_ext <- extmin(MHB_E, MHBC ) # Evidence of Host extended to the product space B x C" bcaPrint(MHB_ext) # # 2. combination of MHB_ext and MHBC MHB_BC_comb <- dsrwon(MHB_ext, MHBC) # "Subsets of the space B x C resulting from the combination of Host extended and MHBC" bcaPrint(MHB_BC_comb) # MHA_BC_comb$con = 0, no need to normalize) MHB_BC_comb$con # # 3. Eliminate variable B MHC <- elim(MHB_BC_comb, xnb = 2) # Final result: the belief function MHC attached to variable C round(belplau(MHC), digits = 2 ) ## ----------------------------------------------------------------------------- MHC_plus_singl <- addTobca(MHC, tt = matrix(c(0,1,0,0,0,1), ncol = 3, byrow = TRUE)) result <- tabresul(MHC_plus_singl) round(result[[1]], digits = 2) cat("\n", " conflict:", result[[2]] )