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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
## extra methods
## binary operators
if(!isGeneric("simplifyr"))
setGeneric("simplifyr",
function(object,
size = 10^getdistrOption("RtoDPQ.e"))
standardGeneric("simplifyr")
)
setMethod("simplifyr", "UnivariateDistribution",
function(object, size = 10^getdistrOption("RtoDPQ.e")){
Sample <- r(object)(size)
rneu <- function(n) sample(x = Sample, size = n, replace = TRUE)
eval.parent(substitute(object@r<-rneu))
})
## function to automatically generate, starting from simulations, density,
## quantile function and cdf
## first version for absolutely continuous, second for discrete distributions
## we use 10^RtoDPQExponent random numbers to generate new distr
## density should use DefaultNrGridPoints equally spaced points for evaluation
RtoDPQ <- function(r, e = getdistrOption("RtoDPQ.e"),
n = getdistrOption("DefaultNrGridPoints"), y = NULL){
zz <- if(!is.null(y)) y else r(10^e)
zz <- zz[!is.na(zz)]
dxy <- xy.coords(density(zz, n = n))
dfun <- .makeDNew(dxy$x, dxy$y, standM = "int")
pf0 <- function(x, y, yleft, yright) ecdf(x)
pfun <- .makePNew(x=zz, dx=0, notwithLLarg=TRUE, myPf = pf0)
## quantile function
yL <- min(zz); yR <- max(zz); rm(zz)
px.l <- pfun(dxy$x); px.u <- pfun(dxy$x, lower.tail = FALSE)
qfun <- .makeQNew(dxy$x, px.l, px.u, TRUE, yL, yR)
rm(px.l, px.u, dxy, pf0)
list(dfun = dfun, pfun = pfun, qfun = qfun)}
RtoDPQ.d <- function(r, e = getdistrOption("RtoDPQ.e")){
zz <- r(10^e)
X <- table(zz)
rm(zz)
supp <- as.numeric(names(X))
prob <- X/(10^e)
rm(X)
len = length(supp)
if(len > 1){
if(min(diff(supp)) <
getdistrOption("DistrResolution"))
stop("grid too narrow --> change DistrResolution")
}
dfun <- .makeDNew(supp, prob, Cont = FALSE)
pfun <- .makePNew(supp, prob, TRUE, Cont = FALSE)
qfun <- .makeQNew(supp, cumsum(prob), rev(cumsum(rev(prob))),
TRUE, min(supp), max(supp), Cont = FALSE)
list(dfun = dfun, pfun = pfun, qfun = qfun)
}
### new from 2.0:
RtoDPQ.LC <- function(r, e = getdistrOption("RtoDPQ.e"),
n = getdistrOption("DefaultNrGridPoints"), y = NULL){
zz <- if(!is.null(y)) y else r(10^e)
hasDis <- FALSE
zz.nr <- zz
zz.T <- table(zz)
zz.T1 <- zz.T[zz.T>1]
zz.replic <- as.numeric(names(zz.T1))
w.d <- sum(zz %in% zz.replic)/10^e
rm(zz.T)
f.d <- Dirac(0)
if(w.d){
hasDis <- TRUE
zz.nr <- zz[! zz %in% zz.replic]
d.r <- zz.T1/sum(zz.T1)
f.d <- DiscreteDistribution(supp = zz.replic, prob = d.r,
.withSim = TRUE, .withArith = TRUE,
.lowerExact = FALSE, .logExact = FALSE)
f.d@.finSupport <- c(TRUE,TRUE)
rm(d.r,zz.replic,zz.T1)
}
rm(zz)
if(1-w.d){
dxy <- xy.coords(density(zz.nr, n = n))
dcfun <- .makeDNew(dxy$x, dxy$y, standM = "int")
pf0 <- function(x, y, yleft, yright) ecdf(x)
pcfun <- .makePNew(x=zz.nr, dx=0, notwithLLarg=TRUE, myPf = pf0)
## quantile function
yL <- min(zz.nr); yR <- max(zz.nr); rm(zz.nr)
px.l <- pcfun(dxy$x); px.u <- pcfun(dxy$x, lower.tail = FALSE)
qcfun <- .makeQNew(dxy$x, px.l, px.u, TRUE, yL, yR)
rm(px.l, px.u, dxy, pf0)
f.c <- AbscontDistribution( r= function(n) qcfun(runif(n)),
d=dcfun, p = pcfun, q = qcfun, .withSim = TRUE,
.withArith = TRUE, .lowerExact = FALSE, .logExact = FALSE)
}
else f.c <-Norm()
UnivarLebDecDistribution(discretePart = f.d, acPart = f.c,
discreteWeight = w.d)
}
####################################################################################
###########################################################
|
