Now we code the PJM (using ACP here) example in DS-ECP.
On SSMW1 : {w1 is T, w1 is F}, we define DSMW1 : 𝒫(SSMW1) → [0, 1] where DSMW1({w1 is T}) = 0.4 and DSMW1({w1 is F}) = 0.6 and DSMW2(X) = 0 for all other X = ∅, {w2 is T, w2 is F}.
tt_SSMw1 <- matrix(c(1,0,0,1,1,1), nrow = 3, ncol = 2, byrow = TRUE)
m_DSMw1 <- matrix(c(0.4,0.6,0), nrow = 3, ncol = 1)
cnames_SSMw1 <- c("w1y", "w1n")
varnames_SSMw1 <- "w1"
idvar_SSMw1 <- 1
DSMw1 <- bca(tt_SSMw1, m_DSMw1, cnames = cnames_SSMw1, idvar = idvar_SSMw1, varnames = varnames_SSMw1)
bcaPrint(DSMw1)
## DSMw1 specnb mass
## 1 w1y 1 0.4
## 2 w1n 2 0.6
Similarly, on SSMW2 : {w2 is T, w2 is F}, we define DSMW2(𝒫)SSMW2 → [0, 1] where DSMW2({w2 is T}) = 0.3 and DSMW2({w2 is F}) = 0.7 and DSMW2(X) = 0 for all other X = ∅, {w2 is T, w2 is F}.
tt_SSMw2 <- matrix(c(1,0,0,1,1,1), nrow = 3, ncol = 2, byrow = TRUE)
m_DSMw2 <- matrix(c(0.3,0.7,0), nrow = 3, ncol = 1)
cnames_SSMw2 <- c("w2y", "w2n")
varnames_SSMw2 <- "w2"
idvar_SSMw2 <- 2
DSMw2 <- bca(tt_SSMw2, m_DSMw2, cnames = cnames_SSMw2, idvar = idvar_SSMw2, varnames = varnames_SSMw2)
bcaPrint(DSMw2)
## DSMw2 specnb mass
## 1 w2y 1 0.3
## 2 w2n 2 0.7
We also need three placeholder SSMs, DSMs. On SSMA : {A is T, A is F}, we define vacuous DSMA : 𝒫(SSMA) → [0, 1] where DSMA({A is T, A is F}) = 1 and DSMA(X) = 0 for all other X = ∅, {A is T}, {A is F}.
tt_SSMA <- matrix(c(1,1), nrow = 1, ncol = 2, byrow = TRUE)
m_DSMA <- matrix(c(1), nrow = 1, ncol = 1)
cnames_SSMA <- c("Ay", "An")
varnames_SSMA <- "A"
idvar_SSMA <- 3
DSMA <- bca(tt_SSMA, m_DSMA, cnames = cnames_SSMA, idvar = idvar_SSMA, varnames = varnames_SSMA)
bcaPrint(DSMA)
## DSMA specnb mass
## 1 frame 1 1
Similarly, on SSMC : {C is T, C is F}, we define vacuous DSMC : 𝒫(SSMC) → [0, 1] where DSMC({C is T, C is F}) = 1 and DSMC(X) = 0 for all other X = ∅, {C is T}, {C is F}.
tt_SSMC <- matrix(c(1,1), nrow = 1, ncol = 2, byrow = TRUE)
m_DSMC <- matrix(c(1), nrow = 1, ncol = 1)
cnames_SSMC <- c("Cy", "Cn")
varnames_SSMC <- "C"
idvar_SSMC <- 4
DSMC <- bca(tt_SSMC, m_DSMC, cnames = cnames_SSMC, idvar = idvar_SSMC, varnames = varnames_SSMC)
bcaPrint(DSMC)
## DSMC specnb mass
## 1 frame 1 1
Similarly, on SSMP : {P is T, P is F}, we define vacuous DSMP : 𝒫(SSMP) → [0, 1] where DSMP({P is T, P is F}) = 1 and DSMP(X) = 0 for all other X = ∅, {P is T}, {P is F}.
tt_SSMP <- matrix(c(1,1), nrow = 1, ncol = 2, byrow = TRUE)
m_DSMP <- matrix(c(1), nrow = 1, ncol = 1)
cnames_SSMP <- c("Py", "Pn")
varnames_SSMP <- "P"
idvar_SSMP <- 5
DSMP <- bca(tt_SSMP, m_DSMP, cnames = cnames_SSMP, idvar = idvar_SSMP, varnames = varnames_SSMP)
bcaPrint(DSMP)
## DSMP specnb mass
## 1 frame 1 1
SSMR1 is on the product space of W1 × A × C × P. DSMR1 : 𝒫(SSMR2) → [0, 1]. When w1 is true, one of A, C are true, which has + = 1 + 2 = 3 cases; when w1 is false, everything can be true, which has $\binom{3}{3} + \binom{3}{2} + \binom{3}{1} = 1 + 3 + 3 = 7$ cases. So DSMR1(X) = 1 if X is the subset of all these cases and 0 otherwise.
tt_SSMR_1 <- matrix(c(1,0,1,0,0,1,0,1,
1,0,0,1,1,0,0,1,
0,1,1,0,0,1,0,1,
0,1,0,1,1,0,0,1,
0,1,0,1,0,1,1,0,
1,1,1,1,1,1,1,1), nrow = 2 + 3 + 1, ncol = 8, byrow = TRUE, dimnames = list(NULL, c("w1y","w1n","Ay","An","Cy","Cn","Py","Pn")))
spec_DSMR_1 <- matrix(c(1,1,1,1,1,2,1,1,1,1,1,0), nrow = 2 + 3 + 1, ncol = 2)
infovar_SSMR_1 <- matrix(c(1,3,4,5,2,2,2,2), nrow = 4, ncol = 2)
varnames_SSMR_1 <- c("w1", "A", "C", "P")
relnb_SSMR_1 <- 1
DSMR_1 <- bcaRel(tt_SSMR_1, spec_DSMR_1, infovar_SSMR_1, varnames_SSMR_1, relnb_SSMR_1)
bcaPrint(DSMR_1)
## DSMR_1
## 1 w1y Ay Cn Pn + w1y An Cy Pn + w1n Ay Cn Pn + w1n An Cy Pn + w1n An Cn Py
## specnb mass
## 1 1 1
SSMR2 is on the product space of W2 × A × C × P. DSMR2 : 𝒫(SSMR2) → [0, 1]. When w2 is true, one of C, P are true, which has 2 + 1 = 3 cases; when w1 is false, everything can be true, which has $\binom{3}{3} + \binom{3}{2} + \binom{3}{1} = 1 + 3 + 3 = 7$ cases. So DSMR2(X) = 1 if X is the subset of all these cases and 0 otherwise.
tt_SSMR_2 <- matrix(c(1,0,0,1,1,0,0,1,
1,0,0,1,0,1,1,0,
0,1,1,0,0,1,0,1,
0,1,0,1,1,0,0,1,
0,1,0,1,0,1,1,0,
1,1,1,1,1,1,1,1), nrow = 2 + 3 + 1, ncol = 8, byrow = TRUE, dimnames = list(NULL, c("w2y","w2n","Ay","An","Cy","Cn","Py","Pn")))
spec_DSMR_2 <- matrix(c(1,1,1,1,1,2,1,1,1,1,1,0), nrow = 2 + 3 + 1, ncol = 2)
infovar_SSMR_2 <- matrix(c(2,3,4,5,2,2,2,2), nrow = 4, ncol = 2)
varnames_SSMR_2 <- c("w2", "A", "C", "P")
relnb_SSMR_2 <- 2
DSMR_2 <- bcaRel(tt_SSMR_2, spec_DSMR_2, infovar_SSMR_2, varnames_SSMR_2, relnb_SSMR_2)
bcaPrint(DSMR_2)
## DSMR_2
## 1 w2y An Cy Pn + w2y An Cn Py + w2n Ay Cn Pn + w2n An Cy Pn + w2n An Cn Py
## specnb mass
## 1 1 1
Now we apply Dempster-Shafer calculus. First, we up-project DSMW1 onto SSMR1 to get DSM1uprojSSMR1 = ({w1 is T} × SSMA × SSMC × SSMP) = 0.4 and DSM1uprojSSMR2({w1 is F} × SSMA × SSMC × SSMP) = 0.6 and DSM1uprojSSMR1(X) = 0 for all other X.
## DSMw1_uproj
## 1 w1y Ay Cy Py + w1y Ay Cy Pn + w1y Ay Cn Py + w1y Ay Cn Pn + w1y An Cy Py + w1y An Cy Pn + w1y An Cn Py + w1y An Cn Pn
## 2 w1n Ay Cy Py + w1n Ay Cy Pn + w1n Ay Cn Py + w1n Ay Cn Pn + w1n An Cy Py + w1n An Cy Pn + w1n An Cn Py + w1n An Cn Pn
## specnb mass
## 1 1 0.4
## 2 2 0.6
Combining DSMW1 with DSMR1 to get DSM1 where DSM1({w1 is T} × {one of A,C is T}) = 0.4 and DSM1({w1 is F} × (SSMA × SSMC × SSMP ∖ {all of A, C, P are F})) = 0.6 and DSM1(X) = 0 for all other X.
## DSM1 specnb mass
## 1 w1y Ay Cn Pn + w1y An Cy Pn 1 0.4
## 2 w1n Ay Cn Pn + w1n An Cy Pn + w1n An Cn Py 2 0.6
Then, down-project DSM1 to SSMA × SSMC × SSMP to get DSM1dprojSSMA × SSMC × SSMP where DSM1dprojSSMA × SSMC × SSMP({one of A,C is T}) = ∑X|SSMW1 ∈ SSMW1DSM1(X) = 0.4 and DSM1dprojSSMA × SSMC × SSMP(SSMA × SSMC × SSMP ∖ {all of A, C, P are F}) = ∑X|SSMW1 ∈ SSMW1DSM1(X) = 0.6 and DSM1dprojSSMA × SSMC × SSMP(X) = 0 for all other X.
## DSM1_dproj specnb mass
## 1 Ay Cn Pn + An Cy Pn 1 0.4
## 2 Ay Cn Pn + An Cy Pn + An Cn Py 2 0.6
Similarly, we up-project DSMW2 onto SSMR2 to get DSM2uprojSSMR2. Combining DSMW2 with DSMR2 to get DSM2. Then, down-project DSM2 to SSMA × SSMC × SSMP to get DSM2dprojSSMA × SSMC × SSMP.
DSMw2_uproj <- extmin(DSMw2,DSMR_2)
DSM2 <- dsrwon(DSMw2_uproj,DSMR_2)
DSM2_dproj <- elim(DSM2,2)
bcaPrint(DSM2_dproj)
## DSM2_dproj specnb mass
## 1 An Cy Pn + An Cn Py 1 0.3
## 2 Ay Cn Pn + An Cy Pn + An Cn Py 2 0.7
Now we can combine DSM1dprojSSMA × SSMC × SSMP and DSM2dprojSSMA × SSMC × SSMP on SSMA × SSMC × SSMP to get DSM3 where DSM3({A is F and C is T and P is F}) = 0.12 and DSM3({(A is T or C is T) and P is F}) = 0.12 and DSM3({A is F and (C is T or P is T)}) = 0.28 and DSM3({One of A,C,P is T}) = 0.42.
## DSM3 specnb mass
## 1 An Cy Pn 1 0.12
## 2 Ay Cn Pn + An Cy Pn 2 0.28
## 3 An Cy Pn + An Cn Py 3 0.18
## 4 Ay Cn Pn + An Cy Pn + An Cn Py 4 0.42
Now, we can marginalize DSM3 to C to get DSM3dprojSSMC where DSM3dprojSSMC({C is T}) = ∑X|SSMA × SSMP ∈ SSMA × SSMPDSM3(X) = 0.12 and DSM3dprojSSMC({C is F}) = ∑X|SSMA × SSMP ∈ SSMA × SSMPDSM3(X) = 0 and DSM3dprojSSMC(X) = 0 for all others. The (p,q,r) triplet on SSMC is then (0.12, 0, 0.88).
## DSM3_dprojSSMC specnb mass
## 1 Cy 1 0.12
## 2 frame 2 0.88