.packageName <- "tdist"
ctdist <- function(x, dff, lambda, pts =14)
{
    tdist(x, dff, lambda, 4, pts)$yfun
}
dtdist <- function(x, dff, lambda = rep(1, length(dff)), pts = 14, log.d = FALSE)
{
    res <- tdist(x, dff, lambda, 2, pts)$yfun
    if(log.d)
        res <- log(res)
    res
}
grule <- function(n)
{
    bp <- rep(0, n); wf <- bp; iter <- 2; m <- trunc((n+1) / 2); e1 <- n * (n+1)
    mm <- 4 * m - 1; tt <- (pi / (4 * n + 2)) * seq(3, mm, 4); nn <- (1 - (1 - 1 / n) / (8 * sqr(n)))
    xo <- nn * cos(tt)
    for(j in 1:iter)
    {
        pkm1 <- 1; pk <- xo
        for(k in 2:n)
        {
            t1 <- xo * pk; pkp1 <- t1 - pkm1 - (t1 - pkm1) / k + t1
            pkm1 <- pk; pk <- pkp1
        }
        den <- 1 - xo * xo; d1 <- n * (pkm1 - xo * pk); dpn <- d1 / den
        d2pn <- (2 * xo * dpn - e1 * pk) / den
        d3pn <- (4 * xo * d2pn + (2 - e1) * dpn) / den
        d4pn <- (6 * xo * d3pn + (6 - e1) * d2pn) / den
        u <- pk / dpn; v <- d2pn / dpn
        h <- -u * (1 + .5 * u * (v + u *(sqr(v) - u * d3pn / (3*dpn))))
        p <- pk + h * (dpn + .5 * h * (d2pn + h / 3 * (d3pn + .25 * h * d4pn)))
        dp <- dpn + h * (d2pn + .5 * h * (d3pn + h * d4pn / 3))
        h <- h - p / dp; xo <- xo + h
    }
    bp <- -xo - h
    fx <- d1 - h * e1 * (pk + h / 2 * (dpn + h / 3 * (d2pn + h / 4 * (d3pn + .2 * h * d4pn))))
    wf <- 2 * (1 - sqr(bp)) / sqr(fx)
    if(2*m > n) bp[m] <- 0
    if(!(2*m == n)) m <- m - 1
    jj <- 1:m; n1j <- (n + 1 - jj); bp[n1j] <- -bp[jj]; wf[n1j] <- wf[jj]
    bp <- (bp+1)/2
    wf <- wf/2
    list('bp' = bp, 'wf' = wf)
}
gweights <- function(limits, ms, bp, wf)
{
    nl <- length(limits)
    tt <- numeric(0); w <- numeric(0)
    for(i in 1:(nl-1))
    {
        lower <- limits[i]
        upper <- limits[i+1]
        mparts <- ms[i]
        d <- (upper - lower) / mparts
        nquad <- length(bp)
        om <- rep(1, mparts)
        on <- rep(1, nquad)
        shift <- 1:mparts - 1
        ti <- d * (bp%*%t(om) + on%*%t(shift)) + lower
        wi <- d * wf%*%t(om)
        tt <- c(tt, as.vector(ti))
        w <- c(w, as.vector(wi))
    }
    list('tt' = tt, 'w' = w)
}
index <- function(x) 1:length(x)
maxv <- function(x, m) tapply(x, 1:length(x), function(y) max(m, y))
minv <- function(x, m) tapply(x, 1:length(x), function(y) min(m, y))
ptdist <- function(q, dff, lambda, pts =14, lower.tail = TRUE, log.p = FALSE)
{
    if(lower.tail)
        res <- tdist(q, dff, lambda, 1, pts)$yfun
    if(!lower.tail)
        res <- 1 - tdist(q, dff, lambda, 1, pts)$yfun
    if(log.p)
        res <- log(res)
    res
}
qtdist <- function(p, dff, lambda, pts =14, lower.tail = TRUE, log.p = FALSE)
{
    if(log.p)
        p <- exp(p)
    if(!lower.tail)
        p <- 1 - p
    res <- tdist(p, dff, lambda, 3, pts)$yfun
    res
}
rtdist <- function(n, dff, lambda)
{
    # Dimensions of lambda and dff should be equal
    if(length(lambda) == 1)
    {
        # If lambda is scalar resize it to size of dff
        lambda <- rep(lambda, length(dff))
    }
    if(length(lambda) == 0)
        lambda <- rep(1, length(dff))            
    if(length(lambda) != length(dff))
    {
        print('!!! lambda should have the same size as dff')
        break
    }
    # Exclude random variables with zero coefficients in lambda
    if(any(lambda))
    {
        kk <- index(lambda)[lambda != 0]
        lambda <- lambda[kk]
        dff <- dff[kk]
    }
    # Exclude random variables with zero or negative coefficients in dff
    kk <- index(dff)[dff > 0]
    if(length(kk) != length(dff))
    {
        print('!!! Excluded random variables with zero or negative dff !')
        lambda <- lambda[kk]
        dff <- dff[kk]
    }
    # Set yfun = NaN if all coefficients in df and/or in lambda are zeros
    if((!all(lambda)) | (!all(dff)))
    {
        yfun <- rep(NaN, length(funx))
        xfun <- funx
        print('!!! yfun=NaN if all coefficients in dff and/or in lambda are zeros !')
        return(list('yfun' <- yfun, 'xfun' <- xfun, 'iserr' <- iserr))
        break
    }
    # Variables with dff == Inf set to be standard normal random variables
    kk <- index(dff)[dff == Inf]
    if(length(kk) != 0) dff[kk] <- 0
    kk <- index(dff)[dff > 100]
    # If length(n) > 1, the length is taken to be the number required
    if(length(n) > 1)
        n <- length(n)
    res <- rep(0, n)
    for(i in 1:length(dff))
    {
       if(dff[i] == 0)            
       res <- res + lambda[i] * rnorm(n)
       if(dff[i] != 0)            
       res <- res + lambda[i] * rt(n, dff[i])
    }
    res
}
sp <- function(x, y) sum(x * y)
sqr <- function(x) x^2
tcdfpdf <- function(x, tt, wf, funtype = 0, nr)
{
    # Integration by Gauss-quadrature
    x <- x / nr
    xsize <- length(x)
    pdf <- 0; cdf <- 0
    if(funtype == 0)
    {
        wft= wf / tt
        for(i in 1:xsize)
        {
            pdf[i]=sp(wf, cos(x[i] * tt))
            cdf[i]=sp(wft, sin(x[i] * tt))
        }
        pdf <- maxv(pdf / pi, 0) / nr
        cdf <- minv(maxv(1 / 2 + cdf / pi, 0), 1)
        yfun <- cbind(cdf, pdf) 
    }
    if(funtype == 1)
    {
        wft <- wf / tt
        for (i in 1:xsize) cdf[i] <- sp(wft, sin(x[i] * tt))
        cdf <- minv(maxv(1 / 2 + cdf / pi, 0), 1)
        yfun <- cdf
    }
    if(funtype == 2)
    {
        for(i in 1:xsize) pdf[i]=sp(wf, cos(x[i] * tt))
        pdf <- maxv(pdf / pi, 0) / nr
    yfun <- pdf
    }
    yfun
}
tchfvw <- function(tt, nu, l)
{
    chf <- rep(1, length(tt))
    kk <- index(tt)
    kkk <- index(nu)[nu>0]
    if(length(kkk) != 0)
        for(k in 1:length(kkk))
        {
            a <- nu[kkk[k]] / 2
            b1 <- abs(l[kkk[k]] * tt[kk] * sqrt(nu[kkk[k]]))
            b2 <- (abs(l[kkk[k]] * tt[kk]) * sqrt(nu[kkk[k]]))^(nu[kkk[k]] / 2)
            b3 <- gamma(nu[kkk[k]] / 2) * (2^(nu[kkk[k]] / 2 - 1))
            chf[kk] <- chf[kk] * besselK(b1, a) * b2 / b3
        }
    kkk <- index(nu)[nu==0]
    if(length(kkk) != 0)
        for(k in 1:length(kkk))
            chf[kk] <- chf[kk] * exp(-1 * sqr(l[kkk[k]] * tt[kk]) / 2) 
    list('chf' = chf, 'tt' = tt)
}
tdist <- function(funx, dff, lambda = rep(1, length(dff)), funtype = 1, pts = 14)
{
    iserr <- 1;
    xfun <- numeric(0);
    yfun <- numeric(0);
    # Choose correct function type
    if(!((funtype == 0) | (funtype == 1) | (funtype == 2) | (funtype == 3) | (funtype == 4)))   
    {
        print('!!! Choose funtype 1 for CDF, 2 for PDF, 3 for INV, or 4 for CHF'); break
    }
    # Dimensions of lambda and df should be equal
    if(length(lambda) == 1)
    {
        # If lambda is scalar resize it to size of df
        lambda <- rep(lambda, length(dff))
    }
    if(length(lambda) == 0) lambda <- rep(1, length(dff))            
    if(length(lambda) != length(dff))
    {
        print('!!! lambda should have the same size as df'); break
    }
    # Exclude random variables with zero coefficients in lambda
    if(any(lambda))
    {
        kk <- index(lambda)[lambda != 0]
        lambda <- lambda[kk]
        dff <- dff[kk]
    }
    # Exclude random variables with zero or negative coefficients in df  
    kk <- index(dff)[dff > 0]
    if(length(kk) !=length(dff))
    {
        iserr <- iserr*0
        print('!!! Excluded random variables with zero or negative dff !')
        lambda <- lambda[kk]
        dff <- dff[kk]
    }
    # Set yfun=NaN if all coefficients in df and/or in lambda are zeros
    if((!all(lambda)) | (!all(dff)))
    {
        yfun <- rep(NaN, length(funx))
        xfun <- funx
        iserr <- iserr*0
        print('!!! yfun=NaN if all coefficients in df and/or in lambda are zeros !')
        return(list('yfun' <- yfun, 'xfun' <- xfun, 'iserr' <- iserr)); break
    }
    # Variables with df > 100 set to be standard normal random variables
    kk <- index(dff)[dff == Inf]
    if(length(kk) != 0) dff[kk] <- 0
    kk <- index(dff)[dff > 100]
    if(length(kk) != 0)
    {
        iserr <- iserr*0
        print('!!! Variables with df > 100 were set to be standard normal random variables !')
        dff[kk] <- 0
    }
    # Find norm of lambda and estimate the approximate 95% range
    lambda <- abs(lambda)
    quant <- c(9.1, 3.6, 2.8, 2.5, 2.3, 2.2, 2.1, 2.1, 2.1, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0)
    dfind <- minv(ceiling(dff), 15)
    kk <- index(dfind)[dfind == 0]
    dfind[kk] <- 15
    qq <- quant[dfind]
    nr <- sqrt(sp(lambda, lambda))
    xupp <- sp(lambda, qq) / nr 
    # Generate an error message if large elements in funx
    if(length(funx) != 0)
    {
        xmax <- max(funx / nr)
        pcrit <- .005 * (((xupp - 2) / 7.1)^5)
        if ((xmax > 70) | ((funtype == 3) & ((1 - max(funx, 1 - min(funx))) < pcrit)))
        {
            iserr <- iserr*0
            print('!!! Large elements in funx ! The result could be inappropriate !')
        }
    }
    # Calculate GaussianQuadratureWeights
    resgrule <- grule(pts)
    bp <- resgrule$bp
    wf <- resgrule$wf
    xmax <- 15
    NN <- xmax * 10
    per <- pi / xmax
    limits <- c(0, 3 * per / 40, per, NN * per)
    ms <- c(3, 3, NN-1)
    resgweights <- gweights(limits, ms, bp, wf)
    tt <- resgweights$tt
    weights <- resgweights$w
    # Evaluate the characteristic function at funx
    if(funtype == 4)
    {
        if(length(funx) == 0) funx <- tt
        restchfvw <- tchfvw(funx, dff, lambda)
        yfun <- restchfvw$chf
        xfun <- restchfvw$tt
    }
    if(funtype != 4)
    {
        chf <- tchfvw(tt, dff, lambda / nr)$chf
        wf <- weights * chf
    }
    # Evaluate the required function
    if ((funtype == 0) | (funtype == 1) | (funtype == 2))
    {
        symetry <- 0
        if(length(funx) == 0)
        {
            funx <- nr * seq(0, xupp, , 51)
            symetry <- 1
        }
        yfun <- tcdfpdf(funx, tt, wf, funtype, nr)
        xfun <- funx
        if((symetry == 1) & (funtype == 0))
        {
            xsize <- length(funx)
            xfun <- c(-funx[seq(xsize, 2, -1)], funx)
            cdf <- yfun[, 1]
            pdf <- yfun[, 2]
            yfun <- matrix(0,length(xfun),2)
            yfun[, 1] <- c(1 - cdf[seq(xsize, 2, -1)], cdf)
            yfun[, 2] <- c(pdf[seq(xsize, 2, -1)], pdf)
        }
        if((symetry == 1) & (funtype == 1))
        {
            xsize <- length(funx)
            xfun <- c(-funx[seq(xsize, 2, -1)], funx)
            cdf <- yfun
            yfun <- c(1 - cdf[seq(xsize, 2, -1)], cdf)
        }
        if((symetry == 1) & (funtype == 2))
        {
            xsize <- length(funx)
            xfun <- c(-funx[seq(xsize, 2, -1)], funx)
            pdf <- yfun
            yfun <- c(pdf[seq(xsize, 2, -1)], pdf)
        }
    }
    if(funtype == 3)
    {
        restinvvw <- tinvvw(funx, tt, wf, nr)
        yfun <- restinvvw$yfun
        xfun <- restinvvw$xfun
        err <- restinvvw$err
        iserr <- iserr * err
    }
    # Change the iserr to be logical output
    if(iserr == 0) iserr <- 1
    if(iserr != 0) iserr <- 0
    # Output
    list('yfun' = yfun, 'xfun' = xfun, 'iserr' = iserr)
}
tinvvw <- function(p, tt, wf, nr)
{
    err <- 1
    if(length(p) == 0) p <- seq(0, 1, , 51)
    qq <- rep(0, length(p))
    # For p=0 set the quantile to be -Inf
    k <- index(p)[p == 0]
    if(any(k))
    {
        tmp <- -1 * Inf
        qq[k] <- rep(tmp, length(k))
    }
    # For p=1 set the quantile to be Inf
    k <- index(p)[p==1]
    if(any(k))
    {
        tmp <- Inf
        qq[k] <- rep(tmp, length(k))
    }
    # Newton's method
    clim <- 100
    count <- 0
    k <- index(p)[p > 0 & p < 1]
    if(length(k) == 0) yfun <- qq
    if(length(k) != 0)
    {
        xfun <- p
        pk <- xfun[k];
        xk <- rep(0, length(pk))
        h <- rep(1, length(pk))
        crit <- 1e-12
        while(any(abs(h) > crit * abs(xk)) & (max(abs(h)) > crit) & (count < clim))
        {
            count <- count + 1;
            yy <- tcdfpdf(xk, tt, wf, 0, nr)
            h <- (yy[,1] - pk) / yy[,2]
            xk <- xk - h
        }
        qq[k] <- xk
        if(count == clim)
        {
            err=0
            print('!!! TINVVW did not converge')
        }
        yfun <- qq
    }
    list('yfun' = yfun, 'xfun' = xfun, 'err' = err)
}
