--- title: "PJM_example_DSC" author: "Peiyuan Zhu" date: "2024-05-13" output: rmarkdown::html_vignette # output: word_document vignette: > %\VignetteIndexEntry{PJM_example_DSC} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r 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) ``` 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}\}$. ```{r} 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) ``` 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}\}$. ```{r} 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) ``` 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}\}$. ```{r} 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) ``` 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}\}$. ```{r} 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) ``` 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}\}$. ```{r} 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) ``` $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 \binom{2}{2} + \binom{2}{1} = 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. ```{r} 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) ``` $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. ```{r} 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) ``` 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$. ```{r} DSMw1_uproj <- extmin(DSMw1,DSMR_1) bcaPrint(DSMw1_uproj) ``` 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$. ```{r} DSM1 <- dsrwon(DSMw1_uproj,DSMR_1) bcaPrint(DSM1) ``` 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$. ```{r} DSM1_dproj <- elim(DSM1,1) bcaPrint(DSM1_dproj) ``` 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}}$. ```{r} DSMw2_uproj <- extmin(DSMw2,DSMR_2) DSM2 <- dsrwon(DSMw2_uproj,DSMR_2) DSM2_dproj <- elim(DSM2,2) bcaPrint(DSM2_dproj) ``` 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$. ```{r} DSM3 <- dsrwon(DSM1_dproj,DSM2_dproj) bcaPrint(DSM3) ``` 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)$. ```{r} DSM3_dprojSSMC <- elim(elim(DSM3, 3), 5) bcaPrint(DSM3_dprojSSMC) ```