Description Usage Arguments Value Author(s) References See Also Examples
Creates a truncated cumulative density function version from a current GAMLSS family distribution.
For continuous distributions left truncation at 3 means that the random variable can take the value 3. For discrete distributions left truncation at 3 means that the random variable can take values from 4 onwards. This is the same for right truncation. Truncation at 15 for a discrete variable means that 15 and greater values are not allowed but for continuous variable it mean values greater that 15 are not allowed (so 15 is a possible value).
1 |
par |
a vector with one (for |
family |
a |
type |
whether |
... |
for extra arguments |
Return a p family function
Mikis Stasinopoulos d.stasinopoulos@londonmet.ac.uk and Bob Rigby r.rigby@londonmet.ac.uk
Rigby, R. A. and Stasinopoulos D. M. (2005). Generalized additive models for location, scale and shape,(with discussion), Appl. Statist., 54, part 3, pp 507-554.
Stasinopoulos D. M., Rigby R.A. and Akantziliotou C. (2003) Instructions on how to use the GAMLSS package in R. Accompanying documentation in the current GAMLSS help files, (see also http://www.gamlss.com/).
trun.d
, trun.q
, trun.r
, gen.trun
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 | # trucated p continuous function
# continuous
#----------------------------------------------------------------------------------------
# left
test1<-trun.p(par=c(0), family="TF", type="left")
test1(1)
(pTF(1)-pTF(0))/(1-pTF(0))
if(abs(test1(1)-(pTF(1)-pTF(0))/(1-pTF(0)))>0.00001) stop("error in left trucation of p")
plot(function(x) test1(x, mu=2, sigma=1, nu=2),0,10)
#----------------------------------------------------------------------------------------
# right
test5 <- trun.p(par=c(10), family="BCT", type="right")
test5(1)
pBCT(1)/pBCT(10)
if(abs(test5(1)-pBCT(1)/pBCT(10))>0.00001) stop("error in right trucation")
test5(1, lower.tail=FALSE)
1-pBCT(1)/pBCT(10)
if(abs(test5(1, lower.tail=FALSE)-(1-pBCT(1)/pBCT(10)))>0.00001) stop("error in right trucation")
test5(1, log.p=TRUE)
log(pBCT(1)/pBCT(10))
if(abs(test5(1, log.p=TRUE)-log(pBCT(1)/pBCT(10)))>0.00001) stop("error in right trucation")
plot(function(x) test5(x, mu=2, sigma=1, nu=2, tau=2),0,10)
plot(function(x) test5(x, mu=2, sigma=1, nu=2, tau=2, lower.tail=FALSE),0,10)
#----------------------------------------------------------------------------------------
# both
test3<-trun.p(par=c(-3,3), family="TF", type="both")
test3(1)
(pTF(1)-pTF(-3))/(pTF(3)-pTF(-3))
if(abs(test3(1)-(pTF(1)-pTF(-3))/(pTF(3)-pTF(-3)))>0.00001) stop("error in right trucation")
test3(1, lower.tail=FALSE)
1-(pTF(1)-pTF(-3))/(pTF(3)-pTF(-3))
if(abs(test3(0, lower.tail=FALSE)-(1-(pTF(0)-pTF(-3))/(pTF(3)-pTF(-3))))>0.00001)
stop("error in right trucation")
plot(function(x) test3(x, mu=2, sigma=1, nu=2, ),-3,3)
plot(function(x) test3(x, mu=2, sigma=1, nu=2, lower.tail=FALSE),-3,3)
#----------------------------------------------------------------------------------------
# Discrete
#----------------------------------------------------------------------------------------
# trucated p function
# left
test4<-trun.p(par=c(0), family="PO", type="left")
test4(1)
(pPO(1)-pPO(0))/(1-pPO(0))
if(abs(test4(1)-(pPO(1)-pPO(0))/(1-pPO(0)))>0.00001) stop("error in left trucation of p")
plot(function(x) test4(x, mu=2), from=1, to=10, n=10, type="h")
cdf <- stepfun(1:40, test4(1:41, mu=5), f = 0)
plot(cdf, main="cdf", ylab="cdf(x)", do.points=FALSE )
#----------------------------------------------------------------------------------------
# right
test2<-trun.p(par=c(10), family="NBI", type="right")
test2(2)
pNBI(2)/(pNBI(9))
if(abs(test2(2)-(pNBI(2)/(pNBI(9))))>0.00001) stop("error in right trucation of p")
plot(function(x) test2(x, mu=2), from=0, to=9, n=10, type="h")
cdf <- stepfun(0:8, test2(0:9, mu=5), f = 0)
plot(cdf, main="cdf", ylab="cdf(x)", do.points=FALSE )
#----------------------------------------------------------------------------------------
# both
test6<-trun.p(par=c(0,10), family="NBI", type="both")
test6(2)
(pNBI(2)-pNBI(0))/(pNBI(9)-pNBI(0))
if(abs(test6(2)-(pNBI(2)-pNBI(0))/(pNBI(9)-pNBI(0)))>0.00001) stop("error in the both trucation")
test6(1, log=TRUE)
log((pNBI(1)-pNBI(0))/(pNBI(9)-pNBI(0)))
if(abs(test6(1, log=TRUE)-log((pNBI(1)-pNBI(0))/(pNBI(9)-pNBI(0))))>0.00001) stop("error in both trucation")
plot(function(y) test6(y, mu=20, sigma=3), from=1, to=9, n=9, type="h") # cdf
plot(function(y) test6(y, mu=300, sigma=.4), from=1, to=9, n=9, type="h") # cdf
cdf <- stepfun(1:8, test6(1:9, mu=5), f = 0)
plot(cdf, main="cdf", ylab="cdf(x)", do.points=FALSE )
#----------------------------------------------------------------------------------------
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.