---
title: "Introduction to Belief Functions"
author: "Claude Boivin^[Retired Statistician, Stat.ASSQ]"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Introduction to Belief Functions}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include = FALSE}
#
# devtools::load_all(".") # only used in place of dst when testing with R-devel
# attach package dst
library(dst) 
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

## Introduction
What is a belief function? In this vignette, an example is given to show the difference between belief functions and probability functions. Specifically, I will show:

* how to use function *bca* to assign a mass function *m* to some subsets of the set of possible values of a variable *A*; the result is called a basic chance assignment or *bca*;
* how to compute the measures of belief and plausibility of a *bca* (functions *belplau* and *tabresul*);
* how to derive a probability distribution from a *bca* (function *plautrans*);
* how to specify a relation *r* between two variables *A* and *B* by way of a mass function *m* on some subsets of the set of possible values of the product space *A x B* (function *bcaRel*);
* how to extend a mass function to a larger space in order to combine it with another mass function already defined on this larger space (function *extmin*);
* how to combine two mass functions (function *dsrwon* for combination and function *nzdsr* for the normalization);
* how obtain a reduced space by eliminating a variable from a relation (marginalization, with function *elim*);
* how to add subsets with 0 mass to a bca (function *addTobca*). This is useful when we want to see the distribution of the singletons.

To learn more about belief functions, see the book of Glenn Shafer ^[Shafer, G., (1976). A Mathematical Theory of Evidence. Princeton University Press, Princeton, New Jersey. 297 pp.]. 

## A simple example of a belief function

Next August, I plan to spend a few days in Forillon National Park. I have already been there many years ago and had to set my tent under  heavy rain, after 10 hours of driving. Not good. This time, I decided to check Canadian Weather and look at the last year's statistics for the month of August before booking.

Unfortunately, there is no historical data about the number of sunny days in a month. Currently, the website gives the quantity of rain each day. Looking at five past years, I count a median number of 14 days of rain or 45% of the days of the month. So, I start my analysis with this information as a probability distribution: (rain: 45% chance, no rain: 55% chance).

What can I infer about the sun? I use the statistics on rain to establish a compatibility relation between rain and sun. If there is rain, there is, generally, no sun. So I put a mass value of 0.45 on the event "no sun". On the other side, no rain does not mean sun; it can also be cloudy. Hence "no rain" is compatible with the event {"sun", "no sun"}, which receive a mass value of 0.55.

Hence, I have defined a belief function by using a known probability distribution on some situation to associate it with another situation where probabilities are unknown. Now, I show how to use function *bca* to encode the events of interest and their mass value. This done, I cant look at the measures of belief and plausibility with function *belplau*.


```{r}
# Evidence for sun
# All the events of interest are encoded in a binary matrix tt.  
# Each column of the matrix is a possible value. 
# Each row is subset of the set of possible values, described by a complete disjunctive coding
Weather_tt <- matrix(c(1,0,0,1,1,1), ncol=2, byrow=TRUE)
Weather <-  bca(tt = Weather_tt, m= c(0, 0.45, 0.55), cnames =c("Sun", "NoSun"), varnames = "Weather", idvar = 1)
Weather$tt
# The belief function of Weather
belplau(Weather)
tabresul(Weather)
```
We don't have a probability distribution here; only one of the two elementary events has received a mass value; The elementary  event "no sun" has a degree of support (belief) of 0.45 and the elementary  event "sun" has a degree of support of 0. The remaining mass of 0.55 has been allotted to the frame ${'Sun', 'NoSun'}$. This is the expression of the part of ignorance that remains. The chances of "sun" are not very good at 0.55. The odds "Sun/No Sun"" are at 0.55. This is the plausibility ratio  given by function *tabresul*. Maybe look at July for my vacation instead of August? Another story. 

If we want to express the result within probability theory, we can apply a transformation to the plausibility distribution of the elementary events to obtain a probability distribution. This is called the plausibility transformation ^[Cobb, B. R. and Shenoy, P.P. (2006). On the plausibility transformation method for translating belief function models to probability models. Journal of Approximate Reasoning, 41(3), April 2006, 314--330.].

```{r}
plautrans(Weather)
```
The plausibility transformation gives a probability of sun 0f 0.35. 

On my trip to Forillon National Park, there will be roadworks eventually. If so I could be arriving too late to set my tent in daylight. From experience, I know that there are generally no roadworks when the weather is bad. However, there could some emergencies. Hence I consider that there still remain 10% chance oh roadworks although it's raining. Let's encode the relation between Weather and Roadworks, using the function *bcaRel*. This encoding is a simple implication rule *a -> b* where a stands for *rain = yes* and b stands for *rdworks = no*.

```{r}
# Relation between Rain and Roadworks
# Define variable Rain. Values: Ry for rain = yes, Rn for rain = no
rain <-  bca(tt = matrix(c(1,0,0,1,1,1), ncol = 2, byrow = TRUE), m=c(0,0, 1), cnames=c("Ry", "Rn"),  varnames = "Rain", idvar = 5)
# Define variable Roadworks Values: Wy for rdworks = yes, Wn for rdworks = no
# Define variable Roadworks
rdworks <-  bca(tt= matrix(c(1,0,0,1,1,1), ncol=2, byrow=TRUE), m= c(0, 0, 1), cnames =c("Wy", "Wn"), varnames = "RdWorks", idvar = 4)
# Establish the relation between Rain and Roadworks
# A simple implication rule
# the binary matrix
ttrwt <- matrix(c(0,1,0,1,
                  0,1,1,0,
                  1,0,0,1,
                  1,1,1,1), nrow=4, byrow = TRUE, dimnames = list(NULL, c("Wy", "Wn", "Ry", "Rn")) )
# I use the function nameRows to name the rows here
rownames(ttrwt) <- nameRows(ttrwt)
ttrwt
inforwt <- matrix(c(4,5,2,2), ncol = 2,  dimnames = list(NULL, c("varnb", "size")) )
specrwt <-  matrix(c(1,1,1,2,
                     0.9,0.9,0.9,0.1), ncol = 2, dimnames = list(NULL, c("specnb", "mass"))) 
# The relation
noW_if_R <- bcaRel(tt = ttrwt, spec = specrwt, infovar = inforwt, varnames = c("RdWorks", "Rain"), relnb = 1)
 noW_if_R
```

It is cloudy on my day of departure. Forecast are 60 % chances of rain today.  We now change the distribution of the bcaspec *rdworks* in order to reflect this condition.
```{r}
# Evidence of rain on the day of departure
rain$spec[,2] <- c(0.6, 0, 0.4)
bcaPrint(rain)
```
Finally, I would like to combine this piece of evidence with the relation between Rain and roadworks in order to evaluate the chances of roadworks on the day of my trip. I proceed in three steps to achieve that:
Firstly extend the Evidence (variable Rain) to the product space Rain x Roadworks.
Secondly, combine the two relations.
Thirdly, marginalize to the variable Roadworks.

First step is done using the function *extmin*.
```{r}
# Evidence of rain extended to the space W x R
rain_xtnd <- extmin(rain, noW_if_R)
bcaPrint(rain_xtnd)
```
Second step is done using functions *dsrwon* and *nzdsr*).
```{r}
# combine the relation noW_if_R with variable rain extended on W x R (rain_xtnd)
comb_rel <- nzdsr(dsrwon(rain_xtnd, noW_if_R))
bcaPrint(comb_rel)
```
Third step: Marginalization is done using function *elim*.
```{r}
# marginalize to variable roadworks by eliminating variable rain (variable nb = 5)
roadworks_ev <- elim(comb_rel, xnb = 5)
belplau(roadworks_ev)
# use function addTobca to show all the singletons
roadworks_ev_plus_sing <- addTobca(roadworks_ev, tt = matrix(c(1,0), ncol = 2))
tabresul(roadworks_ev_plus_sing)
plautrans(roadworks_ev_plus_sing)
```
Finally the results. Function *belplau* shows that the odds of "No roadworks" vs Roadworks are 2.17. Using the plausibility transformation, I obtain a probability of "No Roadworks" of 0.68.