Crime_Scene_Commonality

Introduction

This is an example taken from Geometry of Uncertainty by Fabio Cuzzolin (2021). Suppose we’re a detector investigating a crime scene. There are two witnesses who testified on a murder trial. Three suspects are called into question: Mary, Peter, and John. Mary and John are blonde. From the first witness’s testimony, the suspect was a male. However, as a detective we’re don’t trust the witness fully, because the witness was drunk that day and cannot be completely held accountable for his testimony. Another witness found a blond hair on the floor, but the floor might have been cleaned before the crime scene was controlled, so in that case the hair doesn’t help us narrowing down the suspects.

Belief combination

Now let’s put the above example in the language of belief functions. We start by conceptualizing a frame of discernment \(\Theta=\{\text{Peter}, \text{John}, \text{Mary}\}\) for the outcome of the murder trial. Here we use the word “frame of discernment” to distinguish it from “sample space” in probability theory but they’re mathematically the same. Then we define basic chance assignment as a mapping \(2^\Theta\rightarrow[0,1]\).

With the above representation of the crime scene, two basic chance assignment objects can be created from the two witnesses. The first basic chance assignment assigns 0.8 to \(\{\text{Peter}, \text{John}\}\) and 0.2 to \(\Theta\). This means that the detective imagine that out of all possible situations that could’ve happened, 80% of those have the property such that the witness was not drunk, and out of all possible situations that could’ve happened, 20% of those have the property such that the witness was drunk.

bpa1 <- bca(matrix(c(1,1,0,1,1,1), nrow = 2, byrow = TRUE), c(0.8, 0.2), cnames=c("Peter", "John", "Mary"))
bpa1$tt

##              Peter John Mary
## Peter + John     1    1    0
## frame            1    1    1

bpa1$spec

##              specnb mass
## Peter + John      1  0.8
## frame             2  0.2

The number 0.8 is given out of a subjective judgment by the observer, which seems like it come from nowhere but the philosophy of the belief function is founded upon the view that value judgments e.g. a vote, as relational properties between a system and an observer at the metaphysical level, are as real as (or even more real as) objects e.g. atoms from the traditional, substance-based metaphysical level. In the theory of belief functions, the relation is modeled as an uncertain relation, that is, a mathematical relation between a probability algebra and a frame of discernment.

Using the basic chance assignment object, we can calculate the belplau object, which includes five parameters: belief, disbelief, epistemic uncertainty, plausibility, and plausibility ratio. Here we use the word “belief” “disbelief” instead of “p-value” / “a-value” to distinguish it from upper / lower confidence interval containing objective probabilities as a stochastic variable while assuming it is not a stochastic variable from frequentist hypothesis testing or upper / lower credible interval containing high posterior beliefs from Bayesian hypothesis testing, and “epistemic uncertainty” to distinguish it from length of confidence interval of objective probabilities after controlling for false discovery rate or credible sets.

1. The belief of a hypothesis is justified via summing over basic chance assignments that implies that hypothesis.
2. The disbelief of a hypothesis is justified via summing over basic chance assignments that implies the negation of that hypothesis.
3. The epistemic uncertainty is calculated via the remaining masses that are neither attributed to belief, nor attributed to disbelief.
4. The plausibility is calculated via the remaining masses that are not attributed to disbelief.
5. The plausibility ratio is calculated via the ratio between the remaining masses that are not attributed to disbelief and the remaining masses that are not attributed to belief.

belplau1<-belplau(bpa1)
belplau1

##              bel disbel unc plau rplau
## Peter + John 0.8      0 0.2    1     5
## frame        1.0      0 0.0    1   Inf

In the language of bett

Notice since both belief and basic mass assignment take the same values as both are defined via the summation operation. No belief on any suspect more specific than the entire group, can solemnly justify the entire crime scene. The second chance assignment assigns 0.6 to \(\{\text{John}, \text{Mary}\}\) and 0.4 to \(\Theta\) following the same logic as the first basic chance assignment. Its basic chance assignment object can be created likewise.

bpa2 <- bca(matrix(c(0,1,1,1,1,1), nrow = 2, byrow = TRUE), c(0.6, 0.4), cnames=c("Peter", "John", "Mary"))
bpa2$tt

##             Peter John Mary
## John + Mary     0    1    1
## frame           1    1    1

bpa2$spec

##             specnb mass
## John + Mary      1  0.6
## frame            2  0.4

The belplau object can be computed from the basic chance assignment object by following the same logic as how the first belplau object is created via the first basic chance assignment object.

belplau2<-belplau(bpa2)
belplau2

##             bel disbel unc plau rplau
## John + Mary 0.6      0 0.4    1   2.5
## frame       1.0      0 0.0    1   Inf

Having computed two basic chance assignment objects, we can use dsrwon to combine them and obtain a new basic chance assignment object. We cannot combine belplau objects as it is known that there’s no close form solution to the combined result in general. Here we use the word “combination” to distinguish up-projecting marginal masses into the product space and then down-project onto the marginal space from the masses on the product space in Dempster-Shafer theroy aside from constructing probability measure on the product space, usually done via Kolmogorov extension theorem among the frequentist methods, or random measure from de Finetti theorem among the Bayesian methods. In this case, we directly assign probabilities to the sets to represent our ignorance, which is mathematically equivalent to defining probabilities on the margin of two situations and extending it.

More precisely, the combination rule constructs a new basic chance assignment object by summing over multiplies of masses over intersections from the two input basic chance assignment objects and normalizing over probabilities non-conflicting items. There are several ways to interpret this process.

bpa3<-dsrwon(bpa1, bpa2)

The belplau object can be computed from the basic chance assignment object by following the same logic as how the first belplau object is created via the first basic chance assignment object. Notice the belief on the new set of intersection is multiplied while the belief of the existing two evidences stays put.

belplau3<-belplau(bpa3)
belplau3

##               bel disbel  unc plau    rplau
## John         0.48      0 0.52    1 1.923077
## Peter + John 0.80      0 0.20    1 5.000000
## John + Mary  0.60      0 0.40    1 2.500000
## frame        1.00      0 0.00    1      Inf

In this example, there is no degree of support for Peter, no degree of support for Mary also. It would be interesting to know more about these two people, such as their degree of plausibility. To do that, we add the singletons {peter} and {Mary} to the bpa obtained. See what we get.

bpa3_plus_singl <- addTobca(bpa3, tt = diag(3)) 
belplau(bpa3_plus_singl)

##               bel disbel  unc plau    rplau
## John         0.48    0.0 0.52  1.0 1.923077
## Peter        0.00    0.6 0.40  0.4 0.400000
## Mary         0.00    0.8 0.20  0.2 0.200000
## Peter + John 0.80    0.0 0.20  1.0 5.000000
## John + Mary  0.60    0.0 0.40  1.0 2.500000
## frame        1.00    0.0 0.00  1.0      Inf

Combination with commonlality functions

Alternatively, we can perform combination with commonality functions. After combination, we convert commonality functions directly to belief and plausibility.

bpa3<-dsrwonLogsumexp(bpa1, bpa2, use_qq = TRUE)
belplau3 <- belplauHQQ(bpa3$qq,ttmatrixFromQQ(bpa3$qq,as.integer(bpa3$infovar[1,2]),unlist(bpa3$valuenames)))
round(belplau3, 5)

##               bel disbel  unc plau   rplau
## ø            0.00      1 0.00    0 0.00000
## John         0.48      0 0.52    1 1.92308
## John + Mary  0.60      0 0.40    1 2.50000
## Peter + John 0.80      0 0.20    1 5.00000
## frame        1.00      0 0.00    1     Inf

We can also convert commonality functions back to mass function first and then calculate belief and plausibility as before.

bpa3$tt<-ttmatrixFromQQ(bpa3$qq,as.integer(bpa3$infovar[1,2]),unlist(bpa3$valuenames))
bpa3$spec <- matrix(c(1:nrow(bpa3$tt),mFromQQ(bpa3$qq,bpa3$tt)), ncol = 2, byrow = FALSE, dimnames = list(NULL, c("specnb","mass")))
belplau3<-belplau(bpa3)
round(belplau3, 5)

##               bel disbel  unc plau        rplau
## ø            0.00      1 0.00    0  0.00000e+00
## John         0.48      0 0.52    1  1.92308e+00
## John + Mary  0.60      0 0.40    1  2.50000e+00
## Peter + John 0.80      0 0.20    1  5.00000e+00
## frame        1.00      0 0.00    1 -4.50360e+15

Now add singletons to see belief and plausibility for each person.

bpa3_plus_singl <- addTobca(bpa3, tt = diag(3)) 
round(belplau(bpa3_plus_singl), 5)

##               bel disbel  unc plau        rplau
## ø            0.00    1.0 0.00  0.0  0.00000e+00
## John         0.48    0.0 0.52  1.0  1.92308e+00
## Peter        0.00    0.6 0.40  0.4  4.00000e-01
## Mary         0.00    0.8 0.20  0.2  2.00000e-01
## John + Mary  0.60    0.0 0.40  1.0  2.50000e+00
## Peter + John 0.80    0.0 0.20  1.0  5.00000e+00
## frame        1.00    0.0 0.00  1.0 -4.50360e+15

Now let’s compute the commonality function from the mass function by Fast Zeta transform.

bpa1 <- bca(matrix(c(1,1,0,1,1,1), nrow = 2, byrow = TRUE), c(0.8, 0.2), fzt=TRUE, cnames=c("Peter", "John", "Mary"))
bpa2 <- bca(matrix(c(0,1,1,1,1,1), nrow = 2, byrow = TRUE), c(0.6, 0.4), fzt=TRUE, cnames=c("Peter", "John", "Mary"))
bpa3<-dsrwonLogsumexp(bpa1, bpa2, use_qq = TRUE)

After combination, we perform Fast Mobius Inversion to convert the commonality function to the mass function. First, we create a matrix of all subsets.

ltt <- lapply(X=0:(2**as.integer(bpa3$infovar[1,2])-1), FUN = function(X) {encode(rep(2,as.integer(bpa3$infovar[1,2])), X)})
tt_abc <- matrix(unlist(ltt), ncol=as.integer(bpa3$infovar[1,2]), byrow = TRUE)
colnames(tt_abc) <- unlist(bpa3$valuenames)
rownames(tt_abc) <- nameRows(tt_abc)

Then, we apply Mobius inversion. With the mass function at hand, we can then use Fast Zeta Transform to compute belief and plausibility.

mass <- mFromQQRecursive(bpa3$qq,as.integer(bpa3$infovar[1,2]))
bpa3$tt <- tt_abc[mass>0,]
bpa3$spec <- cbind(1:nrow(bpa3$tt),mass[mass>0])
colnames(bpa3$spec) <- c("specnb","mass")
belplau(bpa3, fzt=TRUE)

##               bel disbel  unc plau    rplau
## ø            0.00   1.00 0.00 0.00 0.000000
## Mary         0.00   0.80 0.20 0.20 0.200000
## John         0.48   0.00 0.52 1.00 1.923077
## John + Mary  0.60   0.00 0.40 1.00 2.500000
## Peter        0.00   0.60 0.40 0.40 0.400000
## Peter + Mary 0.00   0.48 0.52 0.52 0.520000
## Peter + John 0.80   0.00 0.20 1.00 5.000000
## frame        1.00   0.00 0.00 1.00      Inf