# trun.p: Truncated Cumulative Density Function of a gamlss.family... In gamlss.tr: Generating and Fitting Truncated `gamlss.family' Distributions

## Description

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).

## Usage

 ```1 2``` ```trun.p(par, family = "NO", type = c("left", "right", "both"), varying = FALSE, ...) ```

## Arguments

 `par` a vector with one (for `"left"` or `"right"` truncation) or two elements for `"both"`. When the argument `varying = TRUE` then `par` can be a vector or a matrix with two columns respectively. `family` a `gamlss.family` object, which is used to define the distribution and the link functions of the various parameters. The distribution families supported by `gamlss()` can be found in `gamlss.family`. Functions such as BI() (binomial) produce a family object. `type` whether `left`, `right` or in `both` sides truncation is required, (left is the default) `varying` whether the truncation varies for diferent observations. This can be usefull in regression analysis. If `varying = TRUE` then `par` should be an n-length vector for `type` equal `"left"` and `"right"` and an n by 2 matrix for `type="both"` `...` for extra arguments

## Value

Return a p family function

## Author(s)

Mikis Stasinopoulos [email protected] and Bob Rigby

## References

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.org/).

`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 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``` ```# 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 test2 <- trun.p(par=c(10), family="BCT", type="right") test2(1) pBCT(1)/pBCT(10) if(abs(test2(1)-pBCT(1)/pBCT(10))>0.00001) stop("error in right trucation") test2(1, lower.tail=FALSE) 1-pBCT(1)/pBCT(10) if(abs(test2(1, lower.tail=FALSE)-(1-pBCT(1)/pBCT(10)))>0.00001) stop("error in right trucation") test2(1, log.p=TRUE) log(pBCT(1)/pBCT(10)) if(abs(test2(1, log.p=TRUE)-log(pBCT(1)/pBCT(10)))>0.00001) stop("error in right trucation") plot(function(x) test2(x, mu=2, sigma=1, nu=2, tau=2),0,10) plot(function(x) test2(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 test5<-trun.p(par=c(10), family="NBI", type="right") test5(2) pNBI(2)/(pNBI(9)) if(abs(test5(2)-(pNBI(2)/(pNBI(9))))>0.00001) stop("error in right trucation of p") plot(function(x) test5(x, mu=2), from=0, to=9, n=10, type="h") cdf <- stepfun(0:8, test5(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") plot(function(y) test6(y, mu=300, sigma=.4), from=1, to=9, n=9, type="h") cdf <- stepfun(1:8, test6(1:9, mu=5), f = 0) plot(cdf, main="cdf", ylab="cdf(x)", do.points=FALSE ) #---------------------------------------------------------------------------------------- # varying truncation #---------------------------------------------------------------------------------------- # coninuous # left test6<-trun.p(par=c(0,1,2), family="TF", type="left", varying=TRUE) test6(c(2,3,4)) (pTF(c(2,3,4))-pTF(c(0,1,2)))/(1-pTF(c(0,1,2))) test6(c(2,3,4), log.p=TRUE) #---------------------------------------------------------------------------------------- # right test7 <- trun.p(par=c(10,11,12), family="BCT", type="right", varying=TRUE) test7(c(1,2,3)) pBCT(c(1,2,3))/pBCT(c(10,11,12)) test7(c(1,2,3), lower.tail=FALSE) 1-pBCT(c(1,2,3))/pBCT(c(10,11,12)) test7(c(1,2,3), log.p=TRUE) #--------------------------------------------------------------------------------------- # both test8<-trun.p(par=cbind(c(0,1,2), c(10,11,12)), family="TF", type="both", varying=TRUE) test8(c(1,2,3)) (pTF(c(1,2,3))-pTF(c(0,1,2)))/(pTF(c(10,11,12))-pTF(c(0,1,2))) test8(c(1,2,3), lower.tail=FALSE) 1-(pTF(c(1,2,3))-pTF(c(0,1,2)))/(pTF(c(10,11,12))-pTF(c(0,1,2))) #-------------------------------------------------------------------------------------- # discrete #-------------------------------------------------------------------------------------- # left test9<-trun.p(par=c(0,1,2), family="PO", type="left", varying=TRUE) test9(c(1,2,3)) (pPO(c(1,2,3))-pPO(c(0,1,2)))/(1-pPO(c(0,1,2))) #-------------------------------------------------------------------------------------- # right test10<-trun.p(par=c(10,11,12), family="NBI", type="right", varying=TRUE) test10(c(2,3,4)) pNBI(c(2,3,4))/(pNBI(c(9,10,11))) #------------------------------------------------------------------------------------- # both test11<-trun.p(par=rbind(c(0,10), c(1,11), c(2, 12)), family="NBI", type="both", varying=TRUE) test11(c(2,3,4)) (pNBI(c(2,3,4))-pNBI(c(0,1,2)))/(pNBI(c(9,10,11))-pNBI(c(0,1,2))) #------------------------------------------------------------------------------------- ```