Author: Peiyuan Zhu
Date: 2024-05-13

# PJM_example_DSC

#### Peiyuan Zhu

#### 2024-05-13

Now we code the PJM (using ACP here) example in DS-ECP.

On \(SSM_{W_1}:\{w_1\text{ is T},w_1\text{ is F}\}\), we define \(DSM_{W_1}:\mathcal{P}(SSM_{W_1})\rightarrow[0,1]\) where \(DSM_{W_1}(\{w_1\text{ is T}\})=0.4\) and \(DSM_{W_1}(\{w_1\text{ is F}\})=0.6\) and \(DSM_{W_2}(X)=0\) for all other \(X=\emptyset,\{w_2\text{ is T},w_2\text{ 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 \(SSM_{W_2}:\{w_2\text{ is T},w_2\text{ is F}\}\), we define \(DSM_{W_2}(\mathcal{P})SSM_{W_2}\rightarrow[0,1]\) where \(DSM_{W_2}(\{w_2\text{ is T}\})=0.3\) and \(DSM_{W_2}(\{w_2\text{ is F}\})=0.7\) and \(DSM_{W_2}(X)=0\) for all other \(X=\emptyset,\{w_2\text{ is T},w_2\text{ 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 \(SSM_A:\{A\text{ is T},A\text{ is F}\}\), we define vacuous \(DSM_A:\mathcal{P}(SSM_A)\rightarrow[0,1]\) where \(DSM_A(\{A\text{ is T},A\text{ is F}\})=1\) and \(DSM_A(X)=0\) for all other \(X=\emptyset,\{A\text{ is T}\},\{A\text{ 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 \(SSM_C:\{C\text{ is T},C\text{ is F}\}\), we define vacuous \(DSM_C:\mathcal{P}(SSM_C)\rightarrow[0,1]\) where \(DSM_C(\{C\text{ is T},C\text{ is F}\})=1\) and \(DSM_C(X)=0\) for all other \(X=\emptyset,\{C\text{ is T}\},\{C\text{ 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 \(SSM_P:\{P\text{ is T},P\text{ is F}\}\), we define vacuous \(DSM_P:\mathcal{P}(SSM_P)\rightarrow[0,1]\) where \(DSM_P(\{P\text{ is T},P\text{ is F}\})=1\) and \(DSM_P(X)=0\) for all other \(X=\emptyset,\{P\text{ is T}\},\{P\text{ 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

\(SSM_{R_1}\) is on the product space of \(W_1 \times A \times C \times P\). \(DSM_{R_1}: \mathcal{P}(SSM_{R_2}) \rightarrow [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 \(DSM_{R_1}(X)=1\) if \(X\) is the subset of all these cases and \(0\) otherwise.

    tt_SSMR_1 <- matrix(c(1,0,1,0,1,0,0,1,
                         1,0,0,1,1,0,0,1,
                         1,0,1,0,0,1,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,
                         0,1,1,0,1,0,0,1,
                         0,1,0,1,1,0,1,0,
                         0,1,1,0,0,1,1,0,
                         0,1,1,0,1,0,1,0,

                         1,1,1,1,1,1,1,1), nrow = 3 + 7 + 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,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,0), nrow = 3 + 7 + 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 Cy Pn + w1y Ay Cn Pn + w1y An Cy Pn + 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
    ##   specnb mass
    ## 1      1    1

\(SSM_{R_2}\) is on the product space of \(W_2 \times A \times C \times P\). \(DSM_{R_2}: \mathcal{P}(SSM_{R_2}) \rightarrow [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 \(DSM_{R_2}(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,
                         1,0,0,1,1,0,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,
                         0,1,1,0,1,0,0,1,
                         0,1,0,1,1,0,1,0,
                         0,1,1,0,0,1,1,0,
                         0,1,1,0,1,0,1,0,

                         1,1,1,1,1,1,1,1), nrow = 3 + 7 + 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,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,0), nrow = 3 + 7 + 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 Py + w2y An Cy Pn + w2y An Cn Py + w2n Ay Cy Py + w2n Ay Cy Pn + w2n Ay Cn Py + w2n Ay Cn Pn + w2n An Cy Py + w2n An Cy Pn + w2n An Cn Py
    ##   specnb mass
    ## 1      1    1

Now we apply Dempster-Shafer calculus. First, we up-project \(DSM_{W_1}\) onto \(SSM_{R_1}\) to get \(DSM1_{uproj_{SSM_{R_1}}}=(\{w_1\text{ is T}\}\times SSM_A\times SSM_C\times SSM_P)=0.4\) and \(DSM1_{uproj_{SSM_{R_2}}}(\{w_1\text{ is F}\}\times SSM_A\times SSM_C\times SSM_P)=0.6\) and \(DSM1_{uproj_{SSM_{R_1}}}(X)=0\) for all other \(X\).

    DSMw1_uproj <- extmin(DSMw1,DSMR_1)
    bcaPrint(DSMw1_uproj)

    ##                                                                                                             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 \(DSM_{W_1}\) with \(DSM_{R_1}\) to get \(DSM1\) where \(DSM1(\{w_1\text{ is T}\}\times\{\text{one of A,C is T}\})=0.4\) and \(DSM1(\{w_1\text{ is F}\}\times(SSM_A\times SSM_C\times SSM_P\backslash\{\text{all of }A,C,P\text{ are F}\}))=0.6\) and \(DSM1(X)=0\) for all other \(X\).

    DSM1 <- dsrwon(DSMw1_uproj,DSMR_1)
    bcaPrint(DSM1)

    ##                                                                                                     DSM1
    ## 1                                                             w1y Ay Cy Pn + w1y Ay Cn Pn + w1y An Cy 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
    ##   specnb mass
    ## 1      1  0.4
    ## 2      2  0.6

Then, down-project \(DSM1\) to \(SSM_A\times SSM_C\times SSM_P\) to get \(DSM1_{dproj_{SSM_A\times SSM_C\times SSM_P}}\) where \(DSM1_{dproj_{SSM_A\times SSM_C\times SSM_P}}(\{\text{one of A,C is T}\})=\sum_{X|_{SSM_{W_1}} \in SSM_{W_1}}DSM1(X)=0.4\) and \(DSM1_{dproj_{SSM_A\times SSM_C\times SSM_P}}(SSM_A\times SSM_C\times SSM_P\backslash\{\text{all of }A,C,P\text{ are F}\})=\sum_{X|_{SSM_{W_1}} \in SSM_{W_1}}DSM1(X)=0.6\) and \(DSM1_{dproj_{SSM_A\times SSM_C\times SSM_P}}(X)=0\) for all other \(X\).

    DSM1_dproj <- elim(DSM1,1)
    bcaPrint(DSM1_dproj)

    ##                                                                   DSM1_dproj
    ## 1                                             Ay Cy Pn + Ay Cn Pn + An Cy Pn
    ## 2 Ay Cy Py + Ay Cy Pn + Ay Cn Py + Ay Cn Pn + An Cy Py + An Cy Pn + An Cn Py
    ##   specnb mass
    ## 1      1  0.4
    ## 2      2  0.6

Similarly, we up-project \(DSM_{W_2}\) onto \(SSM_{R_2}\) to get \(DSM2_{uproj_{SSM_{R_2}}}\). Combining \(DSM_{W_2}\) with \(DSM_{R_2}\) to get \(DSM2\). Then, down-project \(DSM2\) to \(SSM_A\times SSM_C\times SSM_P\) to get \(DSM2_{dproj_{SSM_A\times SSM_C\times SSM_P}}\).

    DSMw2_uproj <- extmin(DSMw2,DSMR_2)
    DSM2 <- dsrwon(DSMw2_uproj,DSMR_2)
    DSM2_dproj <- elim(DSM2,2)
    bcaPrint(DSM2_dproj)

    ##                                                                   DSM2_dproj
    ## 1                                             An Cy Py + An Cy Pn + An Cn Py
    ## 2 Ay Cy Py + Ay Cy Pn + Ay Cn Py + Ay Cn Pn + An Cy Py + An Cy Pn + An Cn Py
    ##   specnb mass
    ## 1      1  0.3
    ## 2      2  0.7

Now we can combine \(DSM1_{dproj_{SSM_A\times SSM_C\times SSM_P}}\) and \(DSM2_{dproj_{SSM_A\times SSM_C\times SSM_P}}\) on \(SSM_A\times SSM_C\times SSM_P\) to get \(DSM3\) where \(DSM3(\{\text{A is F and C is T and P is F}\})=0.12\) and \(DSM3(\{\text{(A is T or C is T) and P is F}\})=0.12\) and \(DSM3(\{\text{A is F and (C is T or P is T)}\})=0.28\) and \(DSM3(\{\text{One of A,C,P is T}\})=0.42\).

    DSM3 <- dsrwon(DSM1_dproj,DSM2_dproj)
    bcaPrint(DSM3)

    ##                                                                         DSM3
    ## 1                                                                   An Cy Pn
    ## 2                                             Ay Cy Pn + Ay Cn Pn + An Cy Pn
    ## 3                                             An Cy Py + An Cy Pn + An Cn Py
    ## 4 Ay Cy Py + Ay Cy Pn + Ay Cn Py + Ay Cn Pn + An Cy Py + An Cy Pn + An Cn Py
    ##   specnb mass
    ## 1      1 0.12
    ## 2      2 0.28
    ## 3      3 0.18
    ## 4      4 0.42

Now, we can marginalize \(DSM3\) to \(C\) to get \(DSM3_{dproj_{SSM_C}}\) where \(DSM3_{dproj_{SSM_C}}(\{\text{C is T}\})=\sum_{X|_{SSM_A\times SSM_P}\in SSM_A\times SSM_P}DSM3(X)=0.12\) and \(DSM3_{dproj_{SSM_C}}(\{\text{C is F}\})=\sum_{X|_{SSM_A\times SSM_P}\in SSM_A\times SSM_P}DSM3(X)=0\) and \(DSM3_{dproj_{SSM_C}}(X)=0\) for all others. The (p,q,r) triplet on \(SSM_C\) is then \((0.12,0,0.88)\).

    DSM3_dprojSSMC <- elim(elim(DSM3, 3), 5)
    bcaPrint(DSM3_dprojSSMC)

    ##   DSM3_dprojSSMC specnb mass
    ## 1             Cy      1 0.12
    ## 2          frame      2 0.88