Holmes_Burglary.R
In dst: Using the Theory of Belief Functions

## ----setup, include=FALSE-----------------------------------------------------
#devtools::load_all(".") # only used in place of dst when testing with R-devel
library(dst) 
knitr::opts_chunk$set(echo = TRUE)

## -----------------------------------------------------------------------------
tt_SSMa1 <- matrix(c(1,0,0,1,1,1), nrow = 2 + 1, ncol = 2, byrow = TRUE)
m_DSMa1 <- matrix(c(0.95,0.05,0), nrow = 2 + 1, ncol = 1)
cnames_SSMa1 <- c("a1 is y", "a1 is n")
varnames_SSMa1 <- "a1"
idvar_SSMa1 <- 1
DSMa1 <- bca(tt_SSMa1, m_DSMa1, cnames = cnames_SSMa1, idvar = idvar_SSMa1, varnames = varnames_SSMa1)
bcaPrint(DSMa1)

## -----------------------------------------------------------------------------
tt_SSMa2 <- matrix(c(1,0,0,1,1,1), nrow = 2 + 1, ncol = 2, byrow = TRUE)
m_DSMa2 <- matrix(c(0.01,0.99,0), nrow = 2 + 1, ncol = 1)
cnames_SSMa2 <- c("a2 is y", "a2 is n") 
varnames_SSMa2 <- "a2"
idvar_SSMa2 <- 2
DSMa2 <- bca(tt_SSMa2, m_DSMa2, cnames = cnames_SSMa2, idvar = idvar_SSMa2, varnames = varnames_SSMa2)
bcaPrint(DSMa2)

## -----------------------------------------------------------------------------
tt_SSMalarm <- matrix(c(1,0,1,1), nrow = 1 + 1, ncol = 2, byrow = TRUE)
m_DSMalarm <- matrix(c(1,0), nrow = 1 + 1, ncol = 1)
cnames_SSMalarm <- c("alarm is y", "alarm is n") 
varnames_SSMalarm <- "alarm"
idvar_SSMalarm <- 3
DSMalarm <- bca(tt_SSMalarm, m_DSMalarm, cnames = cnames_SSMalarm, idvar = idvar_SSMalarm, varnames = varnames_SSMalarm)
bcaPrint(DSMalarm)

## -----------------------------------------------------------------------------
tt_SSMburglary <- matrix(c(1,1), nrow = 1, ncol = 2, byrow = TRUE)
m_DSMburglary <- matrix(c(1), nrow = 1, ncol = 1)
cnames_SSMburglary <- c("burglary is y", "burglary is n") 
varnames_SSMburglary <- "burglary"
idvar_SSMburglary <- 4
DSMburglary <- bca(tt_SSMburglary, m_DSMburglary, cnames_SSMburglary, idvar = idvar_SSMburglary, varnames = varnames_SSMburglary)
bcaPrint(DSMburglary)

## -----------------------------------------------------------------------------
tt_SSMR1 <- matrix(c(0,1,0,1,0,1,
                     1,0,0,1,0,1,
                     0,1,0,1,1,0,
                     1,0,0,1,1,0,
                     0,1,1,0,0,1,
                     0,1,1,0,1,0,
                     1,0,1,0,1,0,
                     1,1,1,1,1,1), nrow = 7 + 1, ncol = 6, byrow = TRUE, dimnames = list(NULL, c("burglary is y", "burglary is n", "a1 is y", "a1 is n", "alarm is y", "alarm is n")))
spec_DSMR1 <- matrix(c(1,1,1,1,1,1,1,2,
                       1,1,1,1,1,1,1,0), nrow = 7 + 1, ncol = 2)
infovar_SSMR1 <- matrix(c(4,1,3,2,2,2), nrow = 3, ncol = 2)
varnames_SSMR1 <- c("burglary", "a1", "alarm")
relnb_SSMR1 <- 1
DSMR1 <- bcaRel(tt_SSMR1, spec_DSMR1, infovar_SSMR1, varnames_SSMR1, relnb_SSMR1)
bcaPrint(DSMR1)

## -----------------------------------------------------------------------------
tt_SSMR2 <- matrix(c(0,1,0,1,
                     0,1,1,0,
                     1,0,1,0,
                     1,1,1,1), nrow = 3 + 1, ncol = 4, byrow = TRUE, dimnames = list(NULL, c("a2 is y", "a2 is n", "alarm is y", "alarm is n")))
spec_DSMR2 <- matrix(c(1,1,1,2,1,1,1,0), nrow = 3 + 1, ncol = 2)
infovar_SSMR2 <- matrix(c(2,3,2,2), nrow = 2, ncol = 2)
varnames_SSMR2 <- c("a2", "alarm")
relnb_SSMR2 <- 2
DSMR2 <- bcaRel(tt_SSMR2, spec_DSMR2, infovar_SSMR2, varnames_SSMR2, relnb_SSMR2)
bcaPrint(DSMR2)

## -----------------------------------------------------------------------------
tt_SSMR3 <- matrix(c(0,1,0,1,0,1,
                     1,0,0,1,0,1,
                     0,1,0,1,1,0,
                     1,0,0,1,1,0,
                     0,1,1,0,0,1,
                     0,1,1,0,1,0,
                     1,0,1,0,1,0,
                     1,1,1,1,1,1), nrow = 7 + 1, ncol = 6, byrow = TRUE, dimnames = list(NULL, c("burglary is y", "burglary is n", "a2 is y", "a2 is n", "alarm is y", "alarm is n")))
spec_DSMR3 <- matrix(c(1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,0), nrow = 7 + 1, ncol = 2)
infovar_SSMR3 <- matrix(c(4,2,3,2,2,2), nrow = 3, ncol = 2)
varnames_SSMR3 <- c("burglary", "a2", "alarm")
relnb_SSMR3 <- 3
DSMR3 <- bcaRel(tt_SSMR3, spec_DSMR3, infovar_SSMR3, varnames_SSMR3, relnb_SSMR3)
bcaPrint(DSMR3)

## -----------------------------------------------------------------------------
# combine DSMa1, DSMalarm with DSMR1 to eliminate a1 and get DSM1
DSMa1_uproj <- extmin(DSMa1, DSMR1)
DSMalarm_uproj <- extmin(DSMalarm, DSMR1)
DSM1 <- dsrwon(DSMa1_uproj, DSMR1)
DSM1 <- dsrwon(DSMalarm_uproj, DSM1)
DSM1_dproj <- elim(DSM1, 1)
bcaPrint(DSM1_dproj)

## -----------------------------------------------------------------------------
# combine DSMa2, DSMalarm with DSMR2 to get DSM2
DSMa2_uproj <- extmin(DSMa2, DSMR2)
DSMalarm_uproj <- extmin(DSMalarm, DSMR2)
DSM2 <- dsrwon(DSMa2_uproj, DSMR2)
bcaPrint(DSM2)

## -----------------------------------------------------------------------------
# combine DSM2 and DSMR3 to eliminate to eliminate a2 and get DSM4
DSM2_uproj <- extmin(DSM2, DSMR3)
DSM4 <- dsrwon(DSM2_uproj, DSMR3)
DSM4_dproj <- elim(DSM4, 2)
bcaPrint(DSM4_dproj)

## -----------------------------------------------------------------------------
# combine DSM4 and DSM1 to eliminate alarm and get DSM5
DSM5 <- dsrwon(DSM4_dproj, DSM1_dproj)
bcaPrint(DSM4_dproj)
bcaPrint(DSM1_dproj)
bcaPrint(DSM5)
DSM5_dproj <- elim(DSM5, 3)

## -----------------------------------------------------------------------------
DSA <- belplau(DSM5_dproj)
DSA