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:
To learn more about belief functions, see the book of Glenn Shafer 2.
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.
# 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
#> Sun NoSun
#> Sun 1 0
#> NoSun 0 1
#> frame 1 1
# The belief function of Weather
belplau(Weather)
#> bel disbel unc plau rplau
#> Sun 0.00 0.45 0.55 0.55 0.550000
#> NoSun 0.45 0.00 0.55 1.00 1.818182
#> frame 1.00 0.00 0.00 1.00 Inf
tabresul(Weather)
#> $mbp
#> Sun NoSun mass bel disbel unc plau rplau
#> Sun 1 0 0.00 0.00 0.45 0.55 0.55 0.550000
#> NoSun 0 1 0.45 0.45 0.00 0.55 1.00 1.818182
#> frame 1 1 0.55 1.00 0.00 0.00 1.00 Inf
#>
#> $Conflict
#> [1] 0
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 3.
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.
# 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
#> Wy Wn Ry Rn
#> Wn + Rn 0 1 0 1
#> Wn + Ry 0 1 1 0
#> Wy + Rn 1 0 0 1
#> frame 1 1 1 1
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
#> $con
#> [1] 0
#>
#> $tt
#> Wy Ry Wy Rn Wn Ry Wn Rn
#> Wy Rn + Wn Ry + Wn Rn FALSE TRUE TRUE TRUE
#> frame TRUE TRUE TRUE TRUE
#>
#> $qq
#> function (x)
#> {
#> q <- 0
#> for (i in 1:nrow(tt)) {
#> if (all(tt[i, ] - x >= 0)) {
#> q <- q + m[i]
#> }
#> }
#> return(q)
#> }
#> <bytecode: 0x561c420d0370>
#> <environment: 0x561c4a7ecd98>
#>
#> $spec
#> specnb mass
#> Wy Rn + Wn Ry + Wn Rn 1 0.9
#> frame 2 0.1
#>
#> $infovar
#> varnb size
#> RdWorks 4 2
#> Rain 5 2
#>
#> $varnames
#> [1] "RdWorks" "Rain"
#>
#> $valuenames
#> $valuenames$RdWorks
#> [1] "Wy" "Wn"
#>
#> $valuenames$Rain
#> [1] "Ry" "Rn"
#>
#>
#> $ssnames
#> $ssnames[[1]]
#> [1] "Wy Rn" "Wn Ry" "Wn Rn"
#>
#> $ssnames[[2]]
#> [1] "Wy Ry" "Wy Rn" "Wn Ry" "Wn Rn"
#>
#>
#> $inforel
#> relnb depth
#> [1,] 1 2
#>
#> attr(,"class")
#> [1] "list" "bcaspec"
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.
# Evidence of rain on the day of departure
rain$spec[,2] <- c(0.6, 0, 0.4)
bcaPrint(rain)
#> rain specnb mass
#> 1 Ry 1 0.6
#> 2 frame 3 0.4
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.
# Evidence of rain extended to the space W x R
rain_xtnd <- extmin(rain, noW_if_R)
bcaPrint(rain_xtnd)
#> rain_xtnd specnb mass
#> 1 Wy Ry + Wn Ry 1 0.6
#> 2 frame 3 0.4
Second step is done using functions dsrwon and nzdsr).
# 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)
#> comb_rel specnb mass
#> 1 Wn Ry 1 0.54
#> 2 Wy Ry + Wn Ry 3 0.06
#> 3 Wy Rn + Wn Ry + Wn Rn 4 0.36
#> 4 frame 5 0.04
Third step: Marginalization is done using function elim.
# marginalize to variable roadworks by eliminating variable rain (variable nb = 5)
roadworks_ev <- elim(comb_rel, xnb = 5)
belplau(roadworks_ev)
#> bel disbel unc plau rplau
#> Wn 0.54 0 0.46 1 2.173913
#> frame 1.00 0 0.00 1 Inf
# 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)
#> $mbp
#> Wy Wn mass bel disbel unc plau rplau
#> Wn 0 1 0.54 0.54 0.00 0.46 1.00 2.173913
#> Wy 1 0 0.00 0.00 0.54 0.46 0.46 0.460000
#> frame 1 1 0.46 1.00 0.00 0.00 1.00 Inf
#>
#> $Conflict
#> [1] 0
plautrans(roadworks_ev_plus_sing)
#> Wy Wn trplau
#> Wy 1 0 0.3150685
#> Wn 0 1 0.6849315
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.
Retired Statistician, Stat.ASSQ↩︎
Shafer, G., (1976). A Mathematical Theory of Evidence. Princeton University Press, Princeton, New Jersey. 297 pp.↩︎
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.↩︎