ptgpd_psineglog: internal

Description Usage Arguments Details Value Note Author(s) References See Also Examples

View source: R/ptgpd_psineglog.R

Description

internal use only

Usage

1
ptgpd_psineglog(x, y, z, mar1 = c(0, 1, 0.1), mar2 = c(0, 1, 0.1), mar3 = c(0, 1, 0.1), dep = 1.5, A1 = 0, A2 = 0, B1 = 3, B2 = 3, checkconv = TRUE, ...)

Arguments

x
y
z
mar1
mar2
mar3
dep
A1
A2
B1
B2
checkconv
...

Details

internal use only

Value

internal use only

Note

internal use only

Author(s)

P. Rakonczai

References

internal use only

See Also

internal use only

Examples

  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
##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--	or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function (x, y, z, mar1 = c(0, 1, 0.1), mar2 = c(0, 1, 0.1), 
    mar3 = c(0, 1, 0.1), dep = 1.5, A1 = 0, A2 = 0, B1 = 3, B2 = 3, 
    checkconv = TRUE, ...) 
{
    error = FALSE
    Hxyz = NULL
    param = as.numeric(c(mar1, mar2, mar3, dep, A1, A2, B1, B2))
    mux = param[1]
    muy = param[4]
    muz = param[7]
    sigx = param[2]
    sigy = param[5]
    sigz = param[8]
    gamx = param[3]
    gamy = param[6]
    gamz = param[9]
    alpha = param[10]
    if (checkconv) {
        conv = function(x) {
            if (sum(x) < 1) {
                conv.mtx = matrix(NA, 2, 2)
                conv.mtx[1, 1] = d11psiAneglog(x[1], x[2], alpha = alpha, 
                  A1 = A1, A2 = A2, B1 = B1, B2 = B2)
                conv.mtx[1, 2] = d12psiAneglog(x[1], x[2], alpha = alpha, 
                  A1 = A1, A2 = A2, B1 = B1, B2 = B2)
                conv.mtx[2, 1] = d12psiAneglog(x[1], x[2], alpha = alpha, 
                  A1 = A1, A2 = A2, B1 = B1, B2 = B2)
                conv.mtx[2, 2] = d22psiAneglog(x[1], x[2], alpha = alpha, 
                  A1 = A1, A2 = A2, B1 = B1, B2 = B2)
                is.positive.definite(conv.mtx, method = c("chol"))
            }
            else NA
        }
        conv.outer = function(x, y) apply(cbind(x, y), 1, conv)
        x1 = seq(0.01, 1 - 0.01, 0.01)
        y1 = seq(0.01, 1 - 0.01, 0.01)
        Conv = outer(x1, y1, conv.outer)
        if (min(Conv, na.rm = T) == 0) {
            error = T
            image.plot(x1, y1, Conv, col = heat.colors(2))
        }
    }
    if (gamx > 0) {
        epx1 = mux - sigx/gamx
        epx2 = Inf
    }
    else {
        epx1 = -Inf
        epx2 = mux - sigx/gamx
    }
    if (gamy > 0) {
        epy1 = muy - sigy/gamy
        epy2 = Inf
    }
    else {
        epy1 = -Inf
        epy2 = muy - sigy/gamy
    }
    if (gamz > 0) {
        epz1 = muz - sigz/gamz
        epz2 = Inf
    }
    else {
        epz1 = -Inf
        epz2 = muz - sigz/gamz
    }
    if ((min(x) < epx1) | (max(x) > epx2)) {
        error = T
    }
    if ((min(y) < epy1) | (max(y) > epy2)) {
        error = T
    }
    if ((min(z) < epz1) | (max(z) > epz2)) {
        error = T
    }
    if (!error) {
        Hxyz = NA
        tx = tr(x, gamx, mux, sigx)
        ty = tr(y, gamy, muy, sigy)
        tz = tr(z, gamz, muz, sigz)
        tx0 = tr(0, gamx, mux, sigx)
        tz0 = tr(0, gamy, muy, sigy)
        ty0 = tr(0, gamz, muz, sigz)
        dtx = dtr(x, gamx, mux, sigx)
        dty = dtr(y, gamy, muy, sigy)
        dtz = dtr(z, gamz, muz, sigz)
        c0 = -mupsineglog(tx0, ty0, tz0, alpha = alpha, A1 = A1, 
            A2 = A2, B1 = B1, B2 = B2)
        Hxyz = 1/c0 * (mupsineglog(tx, ty, tz, alpha = alpha, 
            A1 = A1, A2 = A2, B1 = B1, B2 = B2) - mupsineglog(pmin(tx, 
            rep(tx0, length(tx))), pmin(ty, rep(tx0, length(tx))), 
            pmin(tz, rep(tz0, length(tz))), alpha = alpha, A1 = A1, 
            A2 = A2, B1 = B1, B2 = B2))
    }
    else print("invalid parameter(s)")
    Hxyz
  }

mgpd documentation built on May 19, 2017, 11:06 p.m.

Search within the mgpd package
Search all R packages, documentation and source code

Questions? Problems? Suggestions? Tweet to @rdrrHQ or email at ian@mutexlabs.com.

Please suggest features or report bugs in the GitHub issue tracker.

All documentation is copyright its authors; we didn't write any of that.