1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
################################
##
## Class: BinomParameter
##
################################
## Access Methods
setMethod("size", "BinomParameter", function(object) object@size)
setMethod("prob", "BinomParameter", function(object) object@prob)
## Replace Methods
setReplaceMethod("size", "BinomParameter",
function(object, value){ object@size <- value; object})
setReplaceMethod("prob", "BinomParameter",
function(object, value){ object@prob <- value; object})
setValidity("BinomParameter", function(object){
if(length(prob(object)) != 1)
stop("prob has to be a numeric of length 1")
if(prob(object) < 0)
stop("prob has to be in [0,1]")
if(prob(object) > 1)
stop("prob has to be in [0,1]")
if(length(size(object)) != 1)
stop("size has to be a numeric of length 1")
if(size(object) < 1)
stop("size has to be a natural greater than 0")
if(!identical(floor(size(object)), size(object)))
stop("size has to be a natural greater than 0")
else return(TRUE)
})
################################
##
## Class: binomial distribution
##
################################
Binom <- function(size = 1,prob = 0.5){
if(length(size)!=1 || length(prob)!=1)
stop("Arguments 'size' and 'prob' must be of length 1")
if(!.isInteger(size) || size < 1 )
stop("Argument 'size' must be a positive integer")
if(prob < 0 || prob > 1 )
stop("Argument 'prob' must be in [0,1]")
if(!.isEqual01(prob)) return(new("Binom", size = size, prob = prob))
if(prob < 0.1) return(Dirac(0)) else return(Dirac(size))
}
## wrapped access methods
setMethod("prob", "Binom", function(object) prob(param(object)))
setMethod("size", "Binom", function(object) size(param(object)))
## wrapped replace methods
setMethod("prob<-", "Binom",
function(object, value) new("Binom", prob = value,
size = size(object)))
setMethod("size<-", "Binom",
function(object, value) new("Binom", prob = prob(object),
size = value))
## Convolution for two binomial distributions Bin(n1,p1) and Bin(n2,p2)
## Distinguish cases
## p1 == p2 und p1 != p2
setMethod("+", c("Binom","Binom"),
function(e1,e2){
newsize <- size(e1) + size(e2)
if(isTRUE(all.equal(prob(e1),prob(e2))))
return(new("Binom", prob = prob(e1), size = newsize,
.withArith = TRUE))
return(as(e1, "LatticeDistribution") + e2)
})
|
