R/ArchimedeanGenerator.R

Defines functions .makeConcordanceTable .invK2 .invK .Kfunc KfuncSlider Kfunc .invPhiSecondDer .invPhiFirstDer .invPhi .PhiSecondDer .PhiFirstDer .Phi0 .Phi PhiSlider Phi archmCheck archmRange archmParam archmList

Documented in archmCheck archmList archmParam archmRange Kfunc KfuncSlider Phi PhiSlider

# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA  02111-1307  USA


################################################################################
# FUNCTION:                 ARCHIMEDEAN COPULAE PARAMETER:
#  archmList                 Returns list of implemented Archimedean copulae
#  archmParam                Sets Default parameters for an Archimedean copula
#  archmRange                Returns the range of valid alpha values
#  archmCheck                Checks if alpha is in the valid range
# FUNCTION:                 ARCHIMEDEAN COPULAE PHI GENERATOR:
#  Phi                       Computes Archimedean Phi, inverse and derivatives
#  PhiSlider                 Displays interactively generator function
#  .Phi                      Computes Archimedean generator Phi
#  .Phi0                     Utility Function
#  .PhiFirstDer              Computes first derivative of Phi
#  .PhiSecondDer             Computes second derivative of Phi
#  .invPhi                   Computes inverse of Archimedean generator
#  .invPhiFirstDer           Computes first derivative of inverse Phi
#  .invPhiSecondDer          Computes second derivative of inverse Phi
# FUNCTION:                 ARCHIMEDEAN DENSITY K GENERATOR:
#  Kfunc                     Computes Archimedean Density Kc and its Inverse
#  KfuncSlider               Displays interactively the density and concordance
#  .Kfunc                    Computes Density for Archimedean Copulae
#  .invK                     Computes Inverse of Density
#  .invK2                    Utility Function
#  .ALPHA                    Utility Function
#  .TAU                      Utility Function
#  .RHO                      Utility Function
################################################################################


################################################################################
# FUNCTION:                  ARCHIMEDEAN COPULAE PARAMETER:
#  archmList                  Returns list of implemented Archimedean copulae
#  archmParam                 Sets default parameters for an Archimedean copula
#  archmCheck                 Checks if alpha is in the valid range
#  archmRange                 Returns the range of valid alpha values


archmList <- 
    function()
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Returns list of implemented Archimedean copulae

    # Compose List:
    ans <- paste(1:22)

    # Return Value:
    ans
}


# ------------------------------------------------------------------------------


archmParam <- 
    function(type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Sets default parameters for Archimedean copulae

    # Arguments:
    #   type - a character string or integer value naming the copula.
    #       By default the first copula will be chosen.

    # Value:
    #   returns a list with two elements, 'param' sets the parameters
    #       which may be a vector, 'range' the range with minimum and
    #       maximum values for each of the parameters.

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Parameter Values:
    B = Inf
    lower=c(-1, 1,-1, 1,-B, 1,  0, 1, 0, 0, 0, 1, 0, 1, 1, 0,-B, 2, 0, 0, 1, 0)
    upper=c( B, B, 1, B, B, B,  1, B, 1, 1,.5, B, B, B, B, B, B, B, B, B, B, 1)
    Alpha=c( 1, 2,.5, 2, 1, 2, .5, 2,.5,.5,.2, 2, 1, 2, 2, 1,.5, 3, 1, 1, 2,.5)

    # Parameter List:
    ans = list(copula = type)
    ans$param = c(alpha = Alpha[Type])
    ans$range = c(lower = lower[Type], upper = upper[Type])

    # Return Value:
    ans
}


# ------------------------------------------------------------------------------


archmRange <- 
    function(type = archmList(), B = Inf)
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Returns the range of valid alpha values

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Range:
    lower = c(-1, 1,-1, 1,-B, 1, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0,-B, 2, 0, 0, 1, 0)
    upper = c( B, B, 1, B, B, B, 1, B, 1, 1,.5, B, B, B, B, B, B, B, B, B, B, 1)

    # Return Value:
    ans = cbind(lower[Type], upper[Type])
    rownames(ans) = type
    colnames(ans) = c("lower", "upper")
    ans
}


# ------------------------------------------------------------------------------


archmCheck <- 
    function(alpha, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Checks if alpha is in the valid range

    # FUNCTION:

    # Type:
    type = match.arg(type)

    # Check:
    ans = TRUE
    range = as.vector(archmRange(type))
    if (alpha < range[1] | alpha > range[2]) {
        print(c(alpha = alpha))
        print(c(range = range))
        stop("alpha is out of range")
    }

    # Return Value:
    invisible(TRUE)
}


################################################################################
# FUNCTION:                  ARCHIMEDEAN COPULAE PHI GENERATOR:
#  Phi                        Computes Archimedean Phi, inverse and derivatives
#  PhiSlider                  Displays interactively generator function
#  .Phi                       Computes Archimedean generator Phi
#  .Phi0                      Utility Function
#  .PhiFirstDer               Computes first derivative of Phi
#  .PhiSecondDer              Computes second derivative of Phi
#  .invPhi                    Computes inverse of Archimedean generator
#  .invPhiFirstDer            Computes first derivative of inverse Phi
#  .invPhiSecondDer           Computes second derivative of inverse Phi


Phi <- 
    function(x, alpha = NULL, type = archmList(), inv = FALSE, 
    deriv = paste(0:2))
{   
    # A function implemented by Diethelm Wuertz

    # Type:
    type = match.arg(type)
    Type = as.integer(type)
    deriv = match.arg(deriv)

    # Default alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # Phi Generator:
    if (inv) {
        if (deriv == "0") {
            ans = .invPhi(x, alpha, type)
            names(ans) = "invPhi"
        }
        if (deriv == "1") {
            ans = .invPhiFirstDer(x, alpha, type)
            names(ans) = "invPhiFirstDer"
        }
        if (deriv == "2") {
            ans = .invPhiSecondDer(x, alpha, type)
            names(ans) = "invPhiSecondDer"
        }
    } else {
        if (deriv == "0") {
            ans = .Phi(x, alpha, type)
            names(ans) = "Phi"
        }
        if (deriv == "1") {
            ans = .PhiFirstDer(x, alpha, type)
            names(ans) = "PhiFirstDer"
        }
        if (deriv == "2") {
            ans = .PhiSecondDer(x, alpha, type)
            names(ans) = "PhiSecondDer"
        }
    }

    # Add Control Attribute:
    attr(ans, "control")<-cbind.data.frame(alpha = alpha, type = type,
        inv = inv, deriv = deriv, row.names = "")

    # Return Value:
    ans
}


# ------------------------------------------------------------------------------


PhiSlider <- 
    function(B = 5)
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Displays interactively the dependence function

    # FUNCTION:

    # Graphic Frame:
    par(mfcol = c(2, 2), cex = 0.7)

    # Internal Function:
    refresh.code = function(...)
    {
        # Startup Counter:
        .counter <- getRmetricsOptions(".counter") + 1
        setRmetricsOptions(.counter = .counter)
        if (.counter < 10) return ()

        # Sliders:
        Copula = as.integer(.sliderMenu(no = 1))
        Counter = c(1,2,3,2,4,2,5,2,5,5,6,2,7,2,2,7,4,8,7,7,2,5)
        No = Counter[Copula]
        N = .sliderMenu(no = 2)
        alpha = .sliderMenu(no = No+2)

        # Skip:
        if (Copula == 13 & alpha == 0) return(invisible())

        # Do we have a strict Copula?
        strict = c(
            "Yes","No","Yes","Yes","Yes","Yes","No","No","Yes","Yes",
            "No","Yes","Yes","Yes","No","Yes","Yes","No","Yes","Yes",
            "No","Yes")[Copula]
        if (alpha < 0 & Copula == 1) strict[1] = "No"
        if (alpha == 0 & Copula == 16) strict[16] = "No"

        # What is the Range?
        RANGE = c(
            "-1|Inf", "1|Inf", "-1|1", "-Inf|inf", "0|1", "0|0.5",
            "0|Inf", "2|Inf")[No]

        # Which one is the Limit Copula?
        limitTitle = rep("NA", times = 22)
        if (alpha == -1)
            limitTitle = c(
                "W ", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA",
                "NA", "NA", "NA", "NA", "NA", "NA", "Pi", "NA", "NA", "NA",
                "NA", "NA")
        if (alpha == 0)
            limitTitle = c(
                "Pi", "NA", "Pi", "NA", "Pi", "NA", "W ", "NA", "Pi", "Pi",
                "Pi", "NA", "NA", "NA", "NA", "W ", "NA", "NA", "L ", "Pi",
                "NA", "Pi")
        if (alpha == 1)
            limitTitle = c(
                "L ", "W ", "L ", "Pi", "NA", "Pi", "Pi", "W ", "NA", "NA",
                "NA", "L ", "Pi", "L ", "W ", "NA", "NA", "NA", "NA", "NA",
                "W ", "NA")
        limitTitle = limitTitle[Copula]
        if (limitTitle == "NA") {
            limitTitle = " "
        } else {
            limitTitle = paste("  Copula = ", limitTitle[1])
        }

        # Plot phi:
        x = (0:N)/N
        Title = paste("Generator Phi - Copula No:", as.character(Copula),
            "\nalpha = ", as.character(alpha), "  Strict = ", strict,
            limitTitle)
        phi.0 = .Phi(x = 0, alpha = alpha, type = as.character(Copula))
        y = .Phi(x = x, alpha = alpha, type = as.character(Copula))
        x = x[y < 1e6]
        y = y[y < 1e6]
        if (is.finite(y[1])) ylim = c(0, y[1]) else ylim = c(0, y[2])
        plot(x = x, y = y, type = "l", ylim = ylim, main = Title[1],
            xlab = "t", ylab = paste("Phi |", RANGE))
        if (N < 100) points(x = x, y = y, pch = 19, cex = 0.5)
        y.inv = .invPhi(x = y, alpha = alpha, type = as.character(Copula))
        lines(x = y.inv, y = y, col = "red", lty = 3)
        abline(h = 0, lty = 3)
        points(0, phi.0, col = "red", pch = 19)

        # Plot phi first and second Derivative:
        y1 = .PhiFirstDer(x = x, alpha = alpha,
            type = as.character(Copula))
        y2 = .PhiSecondDer(x = x, alpha = alpha,
            type = as.character(Copula))
        r1 = max(abs(y1[is.finite(y1)]))
        r2 = max(abs(y2[is.finite(y2)]))
        if (r2 == 0) r2 = 1
        plot(x = x, y = y1/r1, ylim = c(-1, 1), type = "l", xlab = "t",
            ylab = "Derivatives", main = "Phi first and second Derivative",
            col = "blue")
        if (N < 100) points(x = x, y = y1/r1, pch = 19, cex = 0.5)
        lines(x = x, y = y2/r2, col = "red")
        if (N < 100) points(x = x, y = y2/r2, pch = 19, cex = 0.5)
        abline(h = 0, lty = 3)
        mtext("First                  ", 4, col = "blue", cex = 0.75)
        mtext("                 Second", 4, col = "red ", cex = 0.75)
        mtext(paste("x", as.character(round(r1, digits = 2))), 1,
            line = -2, col = "blue", cex = 0.75)
        mtext(paste("x", as.character(round(r2, digits = 2))), 3,
            line = -2, col = "red", cex = 0.75)

        # Plot invPhi:
        Title = paste( "Inverse Phi\n Phi(0) =",
            as.character(round(phi.0, digits = 3)))
        plot(x = y, y = y.inv, type = "l", main = Title,
            xlab = paste("Phi |", RANGE), ylab = "t")
        if (N < 100) points(x = y, y = y.inv, pch = 19, cex = 0.5)
        abline(h = 0, lty = 3)
        points(phi.0, 0, col = "red", pch = 19)

        # Plot invPhi first & second Derivative:
        y = y[y < .Phi0(alpha, Copula)]
        Title = "Inverse Phi 1st Derivative"
        y1.inv = .invPhiFirstDer(x = y, alpha = alpha,
            type = as.character(Copula))
        y2.inv = .invPhiSecondDer(x = y, alpha = alpha,
            type = as.character(Copula))
        r1 = max(abs(y1.inv[is.finite(y1.inv)]))
        r2 = max(abs(y2.inv[is.finite(y2.inv)]))
        if (r2 == 0) r2 = 1
        plot(x = y, y = y1.inv/r1, ylim = c(-1, 1),
            type = "l", xlim = range(y), xlab = paste("Phi |", RANGE),
            ylab = "dewrivatives",
            main = "Inv Phi first and second Derivative", col = "blue")
        if (N < 100) points(x = y, y = y1.inv/r1, pch = 19, cex = 0.5)
        lines(x = y, y = y2.inv/r2, col = "red")
        if (N < 100) points(x = y, y = y2.inv/r2, pch = 19, cex = 0.5)
        abline(h = 0, lty = 3)
        mtext("First                  ", 4, col = "blue", cex = 0.75)
        mtext("                 Second", 4, col = "red ", cex = 0.75)
        mtext(paste("x", as.character(round(r1, digits = 2))), 1,
            line = -2, col = "blue", cex = 0.75)
        mtext(paste("x", as.character(round(r2, digits = 2))), 3,
            line = -2, col = "red", cex = 0.75)

        # Reset Frame:
        par(mfcol = c(2, 2), cex = 0.7)
    }

    # Open Slider Menu:
    setRmetricsOptions(.counter = 10)
    C1 = "1: [-1,Inf]"
    C2 = "2-4-6-8-12-14-15-21: [1,Inf)"
    C3 = "3: [-1,1)"
    C4 = "5-17: (-Inf,Inf)|{0}"
    C5 = "7-9-10-22: (0,1]"
    C6 = "11: (0, 1/2]"
    C7 = "13-16-19-20: (0,Inf)"
    C8 = "18: [2, Inf)"
    C = c(   C1, C2,   C3,   C4,   C5,   C6,   C7,  C8 )
    L = c(   -1,  1,   -1,   -B,    0,    0,    0,   2 )
    U = c(3*B/5,  B,    1,    B,    1,  0.5,  B/2, 2*B )
    A = c(  0.5,  2,  0.5,    1,  0.5,  0.2,    1,   3 )
    V = rep(0.01, 20)
    .sliderMenu(refresh.code,
        names       = c("Copula",  "N", C),
        minima      = c(       1,   10, L),
        maxima      = c(      22, 1000, U),
        resolutions = c(       1,   10, V),
        starts      = c(       1,  100, A))
}


# ------------------------------------------------------------------------------


.Phi <- 
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes Archimedean generator "phi"

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # As listed in Nelsen:
    N = length(x)
    Type = "NA"
    if (type ==  1)
        if (alpha == -1) Type = "W"
        else if (alpha == 0) Type = "Pi"
        else if (alpha == 1) Type = "L"
        else f = 1/alpha*(x^(-alpha)-1)                          # Clayton
    if (type == 2)
        if (alpha == 1) Type = "W"
        else f = (1-x)^alpha
    if (type == 3)
        if (alpha == 0) Type = "Pi"
        else if (alpha == 1) Type = "L"
        else f = log((1-alpha*(1-x))/x)                  # Ali-Mikhail-Haq
    if (type == 4)
        if (alpha == 1) Type = "Pi"
        else f = (-log(x))^alpha                          # Gumbel-Hougard
    if (type == 5)
        if (alpha == 0) Type = "Pi"
        else f = -log((exp(-alpha*x)-1)/(exp(-alpha)-1))           # Frank
    if (type == 6)
        if (alpha == 1) Type = "Pi"
        else f = -log(1-(1-x)^alpha)                                 # Joe
    if (type == 7)
        if (alpha == 0) Type = "W"
        else if (alpha == 1) Type = "Pi"
        else f = -log(alpha*x+(1-alpha))
    if (type == 8)
        if (alpha == 0) Type = "Pi"
        else f = (1-x)/(1+x*(alpha-1))
    if (type == 9)
        if (alpha == 0) Type = "Pi"
        else f = log(1-alpha*log(x))                      # Gumbel-Barnett
    if (type == 10)
        if (alpha == 0) Type = "Pi"
        else f = log(2*x^(-alpha)-1)
    if (type == 11)
        if (alpha == 0) Type = "Pi"
        else f = log(2-x^alpha)
    if (type == 12)
        if (alpha == 1) Type = "L"
        else f = (1/x-1)^alpha
    if (type == 13)
        if (alpha == 1) Type = "Pi"
        else f = (1-log(x))^alpha-1
    if (type == 14)
        if (alpha == 1) Type = "L"
        else f = (x^(-1/alpha)-1)^alpha
    if (type == 15)
        if (alpha == 1) Type = "W"
        else f = (1-x^(1/alpha))^alpha
    if (type == 16)
        if (alpha == 0) Type = "W"
        else f = (alpha/x+1)*(1-x)
    if (type == 17)
        if (alpha == -1) Type = "Pi"
        else f = -log(((1+x)^(-alpha)-1)/(2^(-alpha)-1))
    if (type == 18)
        f = exp(alpha/(x-1))
    if (type == 19)
        if (alpha == 0) Type = "L"
        else f = exp(alpha/x)-exp(alpha)
    if (type == 20)
        if (alpha == 0) Type = "Pi"
        else f = exp(x^(-alpha))-exp(1)
    if (type == 21) if (alpha == 1) Type = "W"
        else f = (1-(1-(1-x)^alpha)^(1/alpha))
    if (type == 22)
        if (alpha == 0) Type = "Pi"
        else f = asin(1-x^alpha)

    if (Type == "Pi") f = -log(x)
    if (Type == "W") f = 1-x
    if (Type == "L") f = 1/x - 1

    f[x == 0] = .Phi0(alpha, type)

    # Return Value:
    f
}


# ------------------------------------------------------------------------------


.Phi0 <-
    function(alpha, type)
{   
    # A function implemented by Diethelm Wuertz

    # Phi(0):
    type <- as.integer(type)
    if (type == 1) phi0 = if (alpha < 0) -1/alpha else Inf
    else if (type ==  2) phi0 = 1
    else if (type ==  3) phi0 = Inf
    else if (type ==  4) phi0 = Inf
    else if (type ==  5) phi0 = Inf
    else if (type ==  6) phi0 = Inf
    else if (type ==  7) phi0 = if (alpha == 0) 1 else -log(1 - alpha)
    else if (type ==  8) phi0 = 1
    else if (type ==  9) phi0 = Inf
    else if (type == 10) phi0 = Inf
    else if (type == 11) phi0 = if (alpha == 0) Inf else log(2)
    else if (type == 12) phi0 = Inf
    else if (type == 13) phi0 = Inf
    else if (type == 14) phi0 = Inf
    else if (type == 15) phi0 = 1
    else if (type == 16) phi0 = if (alpha == 0) 1 else Inf
    else if (type == 17) phi0 = Inf
    else if (type == 18) phi0 = exp(-alpha)
    else if (type == 19) phi0 = Inf
    else if (type == 20) phi0 = Inf
    else if (type == 21) phi0 = 1
    else if (type == 22) phi0 = if (alpha == 0) Inf else pi/2

    # Return Value:
    phi0
}


# ------------------------------------------------------------------------------


.PhiFirstDer <-
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes Derivative of Archimedean generator.

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # FUNCTION:

    # The functions were created by MAPLE:
    N = length(x)
    cType = "NA"
    if (Type == 1)
        if (alpha == -1) cType = "W"
        else if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else f1 = -x^(-alpha-1)
    if (Type == 2)
        if (alpha == 1) cType = "W"
        else f1 = -(1-x)^alpha*alpha/(1-x)
    if (Type == 3)
        if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else f1 = (alpha/x-(1-alpha*(1-x))/x^2)/(1-alpha*(1-x))*x
    if (Type == 4)
        if (alpha == 1) cType = "Pi"
        else f1 = (-log(x))^alpha*alpha/x/log(x)
    if (Type == 5)
        if (alpha == 0) cType = "Pi"
        else f1 = alpha*exp(-alpha*x)/(exp(-alpha*x)-1)
    if (Type == 6)
        if (alpha == 1) cType = "Pi"
        else f1 = -(1-x)^alpha*alpha/(1-x)/(1-(1-x)^alpha)
    if (Type == 7)
        if (alpha == 0) cType = "W"
        else if (alpha == 1) cType = "Pi"
        else f1 = -alpha/(alpha*x+1-alpha)
    if (Type == 8)
        if (alpha == 1) cType = "W"
        else f1 = -1/(1+x*(-1+alpha))-(1-x)/(1+x*(-1+alpha))^2*(-1+alpha)
    if (Type == 9)
        if (alpha == 0) cType = "Pi"
        else f1 = -alpha/x/(1-alpha*log(x))
    if (Type == 10)
        if (alpha == 0) cType = "Pi"
        else f1 = -2*x^(-alpha)*alpha/x/(2*x^(-alpha)-1)
    if (Type == 11)
        if (alpha == 0) cType = "Pi"
        else f1 = -x^alpha*alpha/x/(2-x^alpha)
    if (Type == 12)
        if (alpha == 1) cType = "L"
        else f1 = -(1/x-1)^alpha*alpha/x^2/(1/x-1)
    if (Type == 13)
        if (alpha == 1) cType = "Pi"
        else f1 = -(1-log(x))^alpha*alpha/x/(1-log(x))
    if (Type == 14)
        if (alpha == 1) cType = "L"
        else f1 = -(x^(-1/alpha)-1)^alpha*x^(-1/alpha)/x/(x^(-1/alpha)-1)
    if (Type == 15)
        if (alpha == 1) cType = "W"
        else f1 = -(1-x^(1/alpha))^alpha*x^(1/alpha)/x/(1-x^(1/alpha))
    if (Type == 16)
        if (alpha == 0) cType = "W"
        else f1 = -alpha/x^2*(1-x)-alpha/x-1
    if (Type == 17)
        if (alpha == -1) cType = "Pi"
        else f1 = (1+x)^(-alpha)*alpha/(1+x)/((1+x)^(-alpha)-1)
    if (Type == 18)
        f1 = -alpha/(-1+x)^2*exp(alpha/(-1+x))
    if (Type == 19)
        if (alpha == 0) cType = "L"
        else f1 = -alpha/x^2*exp(alpha/x)
    if (Type == 20)
        if (alpha == 0) cType = "Pi"
        else f1 = -x^(-alpha)*alpha/x*exp(x^(-alpha))
    if (Type == 21)
        if (alpha == 1) cType = "W"
        else f1 = -(1-(1-x)^alpha)^(-(-1+alpha)/alpha)*(1-x)^(-1+alpha)
    if (Type == 22)
        if (alpha == 0) cType = "Pi"
        else f1 = -x^(-1+alpha)*alpha/(2*x^alpha-x^(2*alpha))^(1/2)

    if (cType == "Pi") f1 = -1/x
    if (cType == "W") f1 = rep(-1, times = N)
    if (cType == "L") f1 = -1/x^2

    # Return Value:
    f1
}


# ------------------------------------------------------------------------------


.PhiSecondDer <- 
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes Derivative of Archimedean generator.

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # FUNCTION:

    # The functions were created by MAPLE:
    a = alpha
    N = length(x)
    cType = "NA"
    if (Type == 1)
        if (alpha == -1) cType = "W"
        else if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else f2 = x^(-a-2)*a+x^(-a-2)
    if (Type == 2)
        if (alpha == 1) cType = "W"
        else f2 = (1-x)^(a-2)*a^2-(1-x)^(a-2)*a
    if (Type == 3)
        if (alpha == 0) cType = "Pi"
        else if (alpha == 1) Type = "L"
        else f2 = -1/x^2*(a-1)*(1-a+2*x)/(1-a+x)^2
    if (Type == 4)
        if (alpha == 1) cType = "Pi"
        else f2 = a*((-log(x))^(a-2)*a+(-log(x))^(a-1)-(-log(x))^(a-2))/x^2
    if (Type == 5)
        if (alpha == 0) cType = "Pi"
        else f2 = a^2*exp(-a*x)/(exp(-a*x)-1)^2
    if (Type == 6)
        if (alpha == 1) cType = "Pi"
        else f2 = a*((1-x)^(a-2)*a-(1-x)^(a-2)+(1-x)^(2*a-2))/(-1+(1-x)^a)^2
    if (Type == 7)
        if (alpha == 0) cType = "W"
        else if (alpha == 1) cType = "Pi"
        else f2 = alpha^2/(alpha*x+1-alpha)^2
    if (Type == 8)
        if (alpha == 1) cType = "W"
        else f2 = 2*(a-1)*a/(1+a*x-x)^3
    if (Type == 9)
        if (alpha == 0) cType = "Pi"
        else f2 = -a*(-1+a*log(x)+a)/x^2/(-1+a*log(x))^2
    if (Type == 10)
        if (alpha == 0) cType = "Pi"
        else f2 = -2*a*(x^a*a-2+x^a)/(-2+x^a)^2/x^2
    if (Type == 11)
        if (alpha == 0) cType = "Pi"
        else f2 = -a*(2*x^(a-2)*a-2*x^(a-2)+x^(2*a-2))/(-2+x^a)^2
    if (Type == 12)
        if (alpha == 1) cType = "L"
        else f2 = -(-(x-1)/x)^a*a*(-a+2*x-1)/x^2/(x-1)^2
    if (Type == 13)
        if (alpha == 1) cType = "Pi"
        else f2 = a*((1-log(x))^(a-2)*a+(1-log(x))^(a-1)-(1-log(x))^(a-2))/x^2
    if (Type == 14)
        if (alpha == 1) cType = "L"
        else f2 = ((x^(-1/a)-1)^(a-2)*x^(-2*(a+1)/a)*a+(x^(-1/a)-1)^(a-1) *
            x^(-(1+2*a)/a)+(x^(-1/a)-1)^(a-1)*x^(-(1+2*a)/a) *
            a-(x^(-1/a)-1)^(a-2)*x^(-2*(a+1)/a))/a
    if (Type == 15)
        if (alpha == 1) cType = "W"
        else f2 = ((1-x^(1/a))^(a-2)*x^(-2*(a-1)/a)*a-(1-x^(1/a))^(a-1) *
            x^(-(-1+2*a)/a)+(1-x^(1/a))^(a-1)*x^(-(-1+2*a)/a) *
            a-(1-x^(1/a))^(a-2)*x^(-2*(a-1)/a))/a
    if (Type == 16)
        if (alpha == 0) cType = "W"
        else f2 = 2*a/x^3
    if (Type == 17)
        if (alpha == -1) cType = "Pi"
        else f2 = a*((1+x)^(a-2)*a+2*(1+x)^(a-2)*a*x+(1+x)^(a-2)*a*x^2 -
            1+(1+x)^(a-2)+2*(1+x)^(a-2)*x+(1+x)^(a-2)*x^2) /
            (-1+(1+x)^a)^2/(1+x)^2
    if (Type == 18)
        f2 = a*exp(a/(x-1))*(2*x-2+a)/(x-1)^4
    if (Type == 19)
        if (alpha == 0) cType = "L"
        else f2 = a*exp(a/x)*(2*x+a)/x^4
    if (Type == 20)
        if (alpha == 0) cType = "Pi"
        else f2 = a*exp(x^(-a))*(x^(-a-2)*a+x^(-a-2)+x^(-2*a-2)*a)
    if (Type == 21)
        if (alpha == 1) cType = "W"
        else f2 = -(1-(1-x)^a)^(-(-1+2*a)/a)*(1-x)^(2*a-2) +
            (1-(1-x)^a)^(-(-1+a)/a)*(1-x)^(a-2)*a -
            (1-(1-x)^a)^(-(-1+a)/a)*(1-x)^(a-2) +
            (1-(1-x)^a)^(-(-1+2*a)/a)*(1-x)^(2*a-2)*a
    if (Type == 22)
        if (alpha == 0) cType = "Pi"
        else f2 = -a/x^2*(a*x^(2*a)-2*x^(2*a)+x^(3*a))/(2*x^a-x^(2*a))^(3/2)

    if (cType == "Pi") f2 = 1/x^2
    if (cType == "W") f2 = rep(0, times = N)
    if (cType == "L") f2 = 2/x^3

    # Return Value:
    f2
}


# ------------------------------------------------------------------------------


.invPhi <- 
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes inverse of Archimedean generator.

    # FUNCTION:

    # Type:
    type <- match.arg(type)
    Type <- as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check <- archmCheck(alpha, type)

    # Inverse Generator:
    N = length(x)
    cType = "NA"
    if (Type == 1)
        if (alpha == -1) cType = "W"
        else if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else finv = exp(-log(1 + alpha*x)/alpha)
    if (Type == 2)
        if (alpha == 1) cType = "W"
        else finv = 1 - x^(1/alpha)
    if (Type == 3)
        if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else finv = (1-alpha) / (exp(x)-alpha)
    if (Type == 4)
        if (alpha == 1) cType = "Pi"
        else finv = exp(-x^(1/alpha))
    if (Type == 5)
        if (alpha == 0) cType = "Pi"
        else finv = -log(1+exp(-x)*( exp(-alpha)-1 ) ) / alpha
    if (Type == 6)
        if (alpha == 1) cType = "Pi"
        else finv = 1 - (1 - exp(-x))^(1/alpha)
    if (Type == 7)
        if (alpha == 0) cType = "W"
        else if (alpha == 1) Type = "Pi"
        else finv = (1-exp(x)+alpha*exp(x))/alpha/exp(x)
    if (Type == 8)
        if (alpha == 1) cType = "W"
        else finv = (1-x) / ((alpha-1)*x+1)
    if (Type == 9)
        if (alpha == 0) cType = "Pi"
        else  finv = exp((1-exp(x))/alpha)
    if (Type == 10)
        if (alpha == 0) cType = "Pi"
        else finv = ((1+exp(x))/2 )^(-1/alpha)
    if (Type == 11)
        if (alpha == 0) cType = "Pi"
        else finv = (2-exp(x))^(1/alpha)
    if (Type == 12)
        if (alpha == 1) cType = "L"
        else finv = 1/(1+x^(1/alpha))
    if (Type == 13)
        if (alpha == 1) cType = "Pi"
        else finv = exp(1-(1+x)^(1/alpha))
    if (Type == 14)
        if (alpha == 1) cType = "L"
        else finv = (1+x^(1/alpha))^(-alpha)
    if (Type == 15)
        if (alpha == 1) cType = "W"
        else finv = (1-x^(1/alpha))^alpha
    if (Type == 16)
        if (alpha == 0) cType = "W"
        else finv = (1-alpha-x)/2 + sqrt(((1-alpha-x)^2)/4+alpha)
    if (Type == 17)
        if (alpha == -1) cType = "Pi"
        else finv = (exp(-x)*(2^(-alpha)-1)+1)^(-1/alpha) - 1
    if (Type == 18)
        finv = 1+alpha/log(x)
    if (Type == 19)
        if (alpha == 0) cType = "L"
        else finv = alpha / log(x+exp(alpha))
    if (Type == 20)
        if (alpha == 0) cType = "Pi"
        else finv = exp( -log((log(x+exp(1))))/alpha)
    if (Type == 21)
        if (alpha == 1) cType = "W"
        else finv = 1-(1-(1-x)^alpha)^(1/alpha)
    if (Type == 22)
        if (alpha == 0) cType = "Pi"
        else finv = (1-sin(x))^(1/alpha)

    if (cType == "Pi") finv = exp(-x)
    if (cType == "W") finv = 1 - x
    if (cType == "L") finv = 1 / (x+1)

    # Large x Limit:
    finv[which(x >= .Phi0(alpha, type))] = 0

    # Return Value:
    finv
}


# ------------------------------------------------------------------------------


.invPhiFirstDer <- 
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes first Derivative of inverse Archimedean generator.

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # Generator:
    N = length(x)
    cType = "NA"
    a = alpha
    y = x
    ln = log
    if (Type == 1)
        if (alpha == -1) cType = "W"
        else if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else finv1 = -(1+y*a)^(-(a+1)/a)
    if (Type == 2)
        if (alpha == 1) cType = "W"
        else finv1 = -y^(-(a-1)/a)/a
    if (Type == 3)
        if (alpha == 0) cType = "Pi"
        else if (alpha == 1) cType = "L"
        else  finv1 = (a-1)/(exp(y)-1)^2*exp(y)
    if (Type == 4)
        if (alpha == 1) cType = "Pi"
        else finv1 = -y^(-(a-1)/a)/a*exp(-y^(1/a))
    if (Type ==  5)
        if (alpha == 0) cType = "Pi"
        else finv1 = (-1+exp(a))/(-1+exp(a)-exp(y+a))/a
    if (Type == 6)
        if (alpha == 1) cType = "Pi"
        else finv1 = -exp(-(-ln(exp(y)-1)+y)/a)/(exp(y)-1)/a
    if (Type == 7)
        if (alpha == 0) cType = "W"
        else if (alpha == 1) Type = "Pi"
        else finv1 = (-exp(y)+a*exp(y))/a/exp(y)-(1-exp(y)+a*exp(y))/a/exp(y)
    if (Type == 8)
        if (alpha == 1) cType = "W"
        else finv1 = -a/(1+y*a-y)^2
    if (Type == 9)
        if (alpha == 0) cType = "Pi"
        else finv1 = -1/a*exp((y*a-exp(y)+1)/a)
    if (Type == 10)
        if (alpha == 0) cType = "Pi"
        else finv1 = -1/(exp(y)+1)/a*exp((y*a+ln(2)-ln(exp(y)+1))/a)
    if (Type == 11)
        if (alpha == 0) cType = "Pi"
        else finv1 = -(-exp(y)+2)^(-(a-1)/a)/a*exp(y)
    if (Type == 12)
        if (alpha == 1) cType = "L"
        else finv1 = -1/(y^(1/a)+1)^2*y^(-(a-1)/a)/a
    if (Type == 13)
        if (alpha == 1) cType = "Pi"
        else finv1 = -(1+y)^(-(a-1)/a)/a*exp(-(1+y)^(1/a)+1)
    if (Type == 14)
        if (alpha == 1) cType = "L"
        else finv1 = -(y^(1/a)+1)^(-a-1)*y^(-(a-1)/a)
    if (Type == 15)
        if (alpha == 1) cType = "L"
        else finv1 = -(-y^(1/a)+1)^(a-1)*y^(-(a-1)/a)
    if (Type == 16)
        if (alpha == 0) cType = "W"
        else finv1 = -1/2+1/4/(a^2+2*a+2*a*y+1-2*y+y^2)^(1/2)*(2*a-2+2*y)
    if (Type == 17)
        if (alpha == -1) cType = "Pi"
        else finv1 = -(2^(-a)-1+exp(y))^(-1/a)*exp(1/a*y) *
            (-1+2^a)/a/(1-2^a+exp(y)*2^a)
    if (Type == 18)
        finv1 = -a/ln(y)^2/y
    if (Type == 19)
        if (alpha == 0) cType = "L"
        else finv1 = -a/ln(exp(a)+y)^2/(exp(a)+y)
    if (Type == 20)
        if (alpha == 0) cType = "Pi"
        else finv1 = -ln(exp(1)+y)^(-(a+1)/a)/a/(exp(1)+y)
    if (Type == 21)
        if (alpha == 1) cType = "W"
        else finv1 = -exp((log(1-y)*a^2+log(-(1-y)^a+1))/a)/(-1+y)/((1-y)^a-1)
    if (Type == 22)
        if (alpha == 0) cType = "Pi"
        else finv1 = -cos(y)*(1-sin(y))^(-(-1+a)/a)/a

    if (cType == "Pi") finv1 = -exp(-x)
    if (cType == "W") finv1 = rep(-1, times = N)
    if (cType == "L") finv1 = -1 / (x+1)^2

    # Large x Limit:
    finv1[which(x >= .Phi0(a, type))] = 0

    # Return Value:
    finv1
}


# ------------------------------------------------------------------------------


.invPhiSecondDer <- 
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes first Derivative of inverse Archimedean generator.

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # Generator:
    N = length(x)
    cType = "NA"
    a = alpha
    y = x
    ln = log
    if (Type == 1) if (alpha == 0) finv2 = exp(-y) else finv2 =
        finv2 = (1+y*a)^(-(2*a+1)/a)*(a+1)
    if (Type == 2)
        if (alpha == 1) cType = "W"
        else finv2 = y^(-(2*a-1)/a)*(a-1)/a^2
    if (Type == 3)
        if (alpha == 0) cType = "Pi"
        else if (alpha == 1) Type = "L"
        else  finv2 = -(a-1)*exp(y)*(exp(y)+1)/(exp(y)-1)^3
    if (Type == 4)
        if (alpha == 1) cType = "Pi"
        else finv2 = exp(-y^(1/a))*(y^(-(2*a-1)/a)*a-y^(-(2*a-1)/a) +
            y^(-2*(a-1)/a))/a^2
    if (Type == 5)
        if (alpha == 0) cType = "Pi"
        else finv2 = (-1+exp(a))/(-1+exp(a)-exp(y+a))^2/a*exp(y+a)
    if (Type == 6)
        if (alpha == 1) cType = "Pi"
        else finv2 = (-exp(-(-ln(exp(y)-1)+y)/a) +
            exp((ln(exp(y)-1)-y+y*a)/a)*a) / (exp(y)-1)^2/a^2
    if (Type == 7)
        if (alpha == 0) cType = "W"
        else if (alpha == 1) Type = "Pi"
        else finv2 = -(-exp(y)+a*exp(y))/a/exp(y)+(1-exp(y)+a*exp(y))/a/exp(y)
    if (Type == 8)
        if (alpha == 1) cType = "W"
        else finv2 = 2*a/(1+y*a-y)^3*(a-1)
    if (Type == 9)
        if (alpha == 0) cType = "Pi"
        else finv2 = -1/a^2*(a-exp(y))*exp((y*a-exp(y)+1)/a)
    if (Type == 10)
        if (alpha == 0) cType = "Pi"
        else finv2 = -(exp((y*a+ln(2)-ln(exp(y)+1))/a)*a-exp((2*y*a+ln(2) -
            ln(exp(y)+1))/a))/(exp(y)+1)^2/a^2
    if (Type == 11)
        if (alpha == 0) cType = "Pi"
        else finv2 = -exp(y)*((-exp(y)+2)^(-(2*a-1)/a)*exp(y)*a -
            (-exp(y)+2)^(-(2*a-1)/a)*exp(y)+(-exp(y)+2)^(-(a-1)/a)*a)/a^2
    if (Type == 12)
        if (alpha == 1) cType = "L"
        else finv2 = (y^(-2*(a-1)/a)+y^(-2*(a-1)/a)*a+y^(-(2*a-1)/a)*a -
            y^(-(2*a-1)/a))/(y^(1/a)+1)^3/a^2
    if (Type == 13)
        if (alpha == 1) cType = "Pi"
        else finv2 = exp(-(1+y)^(1/a)+1)*((1+y)^(1/a)*a-(1+y)^(1/a) +
            (1+y)^(-2*(a-1)/a)+2*(1+y)^(-2*(a-1)/a)*y +
            (1+y)^(-2*(a-1)/a)*y^2)/a^2/(1+2*y+y^2)
    if (Type == 14)
        if (alpha == 1) cType = "L"
        else finv2 = ((y^(1/a)+1)^(-a-2)*y^(-2*(a-1)/a)*a +
            (y^(1/a)+1)^(-a-2)*y^(-2*(a-1)/a)+(y^(1/a)+1)^(-a-1) *
            y^(-(2*a-1)/a)*a-(y^(1/a)+1)^(-a-1)*y^(-(2*a-1)/a))/a
    if (Type == 15)
        if (alpha == 1) cType = "L"
        else finv2 = (a-1)*((-y^(1/a)+1)^(a-2)*y^(-2*(a-1)/a) +
            (-y^(1/a)+1)^(a-1)*y^(-(2*a-1)/a))/a
    if (Type == 16)
        if (alpha == 0) cType = "W"
        else finv2 = 2*a/(a^2+2*a+2*a*y+1-2*y+y^2)^(3/2)
    if (Type == 17)
        if (alpha == -1) cType = "Pi"
        else finv2 = (2^(-a)-1+exp(y))^(-1/a)*(exp(y*(a+1)/a) -
            2^(a+1)*exp(y*(a+1)/a)+exp(y*(a+1)/a)*4^a +
            exp(1/a*y)*2^(-a)-3*exp(1/a*y)+3*exp(1/a*y)*2^a -
            exp(1/a*y)*4^a-exp(y*(a+1)/a)*a+2^(a+1) *
            exp(y*(a+1)/a)*a- exp(y*(2*a+1)/a)*a*2^a -
            exp(y*(a+1)/a)*a*4^a+exp(y*(2*a+1)/a)*a*4^a)/a^2/(2^(-a)-1 +
            exp(y))/(1-2^a+exp(y)*2^a)^2
    if (Type == 18)
        finv2 = a*(2+ln(y))/ln(y)^3/y^2
    if (Type == 19)
        if (alpha == 0) cType = "L"
        else finv2 = a*(2+ln(exp(a)+y))/ln(exp(a)+y)^3/(exp(a)+y)^2
    if (type == 20)
        if (alpha == 0) cType = "Pi"
        else finv2 = (ln(exp(1)+y)^(-(2*a+1)/a)*a +
            ln(exp(1)+y)^(-(2*a+1)/a) +
            ln(exp(1)+y)^(-(a+1)/a)*a)/a^2/(exp(1)+y)^2
    if (Type == 21)
        if (alpha == 1) cType = "W"
        else finv2 = -(-(1-y)^a+1)^(1/a)*((1-y)^(2*a)-(1-y)^a -
            a*(1-y)^(2*a)+a*(1-y)^a+(1-y)^(2*a-2)*a -
            2*(1-y)^(2*a-2)*a*y+(1-y)^(2*a-2)*a*y^2 -(
            1-y)^(2*a-2)+2*(1-y)^(2*a-2)*y-(1-y)^(2*a-2)*y^2) /
            (-1+y)^2/(-(1-y)^(2*a)+2*(1-y)^a-1)
    if (Type == 22)
        if (alpha == 0) cType = "Pi"
        else finv2 = -(1-sin(y))^(1/a)*(cos(y)^2 +
            a*sin(y)-2*sin(y)+a-2)/cos(y)^2/a^2

    if (cType == "Pi") finv2 = exp(-x)
    if (cType == "W") finv2 = rep(0, times = N)
    if (cType == "L") finv2 = 2 / (x+1)^3

    # Large x Limit:
    finv2[which(x>=.Phi0(a, type))] = 0

    # Return Value:
    finv2
}


################################################################################
# FUNCTION:                  ARCHIMEDEAN DENSITY K GENERATOR:
#  Kfunc                      Computes Archimedean Density Kc and its Inverse
#  KfuncSlider                Displays interactively the density and concordance
#  .Kfunc                     Computes Density for Archimedean Copulae
#  .invK                      Computes Inverse of Density
#  .invK2                     Utility Function
#  .ALPHA                     Utility Function
#  .TAU                       Utility Function
#  .RHO                       Utility Function


Kfunc <-
    function(x, alpha = NULL, type = archmList(), inv = FALSE, lower = 1.0e-8)
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes density and its inverse for Archimedean Copulae

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Default alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # Density or its inverse:
    if (!inv) {
        ans = .Kfunc(x, alpha, type)
        names(ans)<-"Kfunc"
    } else {
        ans = .invK(x, alpha, type, lower)
        names(ans)<-"invK"
    }

    # Add Control Attribute:
    attr(ans, "control")<-cbind.data.frame(alpha = alpha, type = type,
        inv = inv, lower = lower, row.names = "")

    # Return Value:
    ans
}


# ------------------------------------------------------------------------------


KfuncSlider <- 
    function(B = 5)
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Displays interactively the density and concordance

    # FUNCTION:

    # Graphic Frame:
    par(mfcol = c(2, 2), cex = 0.7)

    # Internal Function:
    refresh.code = function(...)
    {
        # Startup Counter:
        .counter <- getRmetricsOptions(".counter") + 1
        setRmetricsOptions(.counter = .counter)
        if (.counter < 10) return ()

        # Sliders:
        Copula = as.integer(.sliderMenu(no = 1))
        Counter = c(1,2,3,2,4,2,5,2,5,5,6,2,7,2,2,7,4,8,7,7,2,5)
        No = Counter[Copula]
        N = .sliderMenu(no = 2)
        alpha = .sliderMenu(no = No+2)

        # Skip:
        if (Copula == 13 & alpha == 0) return(invisible())

        # Do we have a strict Copula?
        strict = c(
            "Yes","No","Yes","Yes","Yes","Yes","No","No","Yes","Yes",
            "No","Yes","Yes","Yes","No","Yes","Yes","No","Yes","Yes",
            "No","Yes")[Copula]
        if (alpha < 0 & Copula == 1) strict[1] = "No"
        if (alpha == 0 & Copula == 16) strict[16] = "No"

        # What is the Range?
        RANGE = c(
            "-1|Inf", "1|Inf", "-1|1", "-Inf|inf", "0|1", "0|0.5",
            "0|Inf", "2|Inf")[No]

        # Which one is the Limit Copula?
        limitTitle = rep("NA", times = 22)
        if (alpha == -1)
            limitTitle = c(
                "W ", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA",
                "NA", "NA", "NA", "NA", "NA", "NA", "Pi", "NA", "NA", "NA",
                "NA", "NA")
        if (alpha == 0)
            limitTitle = c(
                "Pi", "NA", "Pi", "NA", "Pi", "NA", "W ", "NA", "Pi", "Pi",
                "Pi", "NA", "NA", "NA", "NA", "W ", "NA", "NA", "L ", "Pi",
                "NA", "Pi")
        if (alpha == 1)
            limitTitle = c(
                "L ", "W ", "L ", "Pi", "NA", "Pi", "Pi", "W ", "NA", "NA",
                "NA", "L ", "Pi", "L ", "W ", "NA", "NA", "NA", "NA", "NA",
                "W ", "NA")
        limitTitle = limitTitle[Copula]
        if (limitTitle == "NA") {
            limitTitle = " "
        } else {
            limitTitle = paste("  Copula = ", limitTitle[1])
        }

        # Plot 1 - Kfunc:
        x = (0:N)/N
        y = .Kfunc(x = x, alpha = alpha, type = as.character(Copula))
        plot(x = x, y = y, ylim = c(0, 1), type = "l", xlab = "t", ylab = "K")
        title(main = paste("K - Archimedean Copula No:", as.character(Copula),
            "\nalpha = ", as.character(alpha), "  Strict = ", strict,
            limitTitle))
        if (N < 100) points(x = x, y = y, pch = 19, cex = 0.5)
        y10 = .Kfunc(x = (0:10)/10, alpha = alpha, type = as.character(Copula))
        invK10 = .invK2(y10, alpha = alpha, type = as.character(Copula))
        points(invK10, y10, col = "red")
        text(x = 0.8, y = 0.075, labels = "Test: invK[invK]", col = "red")

        # Plot 2 - archmTau:
        tau = .archmTau(alpha = alpha, type = as.character(Copula))
        rho = approx(.ALPHA[, Copula], .RHO[, Copula], xout = alpha)$y
        plot(x = .ALPHA[, Copula], y = .TAU[, Copula], ylim = c(-1, 1),
            type = "l", col = "red",
            xlab = paste("alpha: ", RANGE, sep = ""), ylab = "Tau")
        # points(x = .ALPHA[, Copula], y = .TAU[, Copula], pch = 19, cex = 0.5)
        lines(x = .ALPHA[, Copula], y = .RHO[, Copula], col = "blue")
        # points(x = .ALPHA[, Copula], y = .RHO[, Copula], pch = 19, cex = 0.5)

        points(x = alpha, y = tau, pch = 19, col = "red")
        abline(h = .archmTauRange(type = as.character(Copula))[1], lty =3,
            col = "steelblue")
        abline(h = .archmTauRange(type = as.character(Copula))[2], lty =3,
            col = "steelblue")
        points(x = alpha, y = rho, col = "blue", pch = 19)
        mtext("rho          ", 4, col = "blue", cex = 0.75)
        mtext("          tau", 4, col = "red ", cex = 0.75)
        title(main = paste("Concordance Measures",
            "\ntau = ", as.character(round(tau, digits = 2)),
            "rho = ", as.character(round(rho, digits = 2)) ) )


        plot(x = y, y = x, xlim = c(0, 1), type = "l", xlab = "K", ylab = "t")
        title(main = "Inverse K")

        # Plot 3 - lambda U:
        # xTail = 1 - (1/2)^(1:20)
        # Tail = .archmTail(alpha = alpha, type = as.character(Copula))
        # plot(x = xTail, y = Tail$lambdaU.Cuv, col = "blue",
        #     xlim = c(0, 1), ylim = c(0, 1), main = "Tail Dependence")
        # points(x = xTail, y = Tail$lambdaU.Phi, col = "red", pch = 3)

        # Rho:
        # Rho = NULL
        # for ( a in Alpha)
        #   Rho = c(Rho, archmRho(alpha = a, type = as.character(Copula)))
        # lines(x = Alpha, y = Rho, type = "l", col = "blue")
        # rho =  archmRho(alpha = alpha, type = as.character(Copula))
        # points(x = alpha, y = rho, col = "red", pty = 19)

        # plot(rnorm(100))
        # plot(rnorm(100))

        # Reset Frame:
        par(mfcol = c(2, 2), cex = 0.7)
    }

    # Open Slider Menu:
    setRmetricsOptions(.counter = 0)
    C1 = "1: [-1,Inf]"
    C2 = "2-4-6-8-12-14-15-21: [1,Inf)"
    C3 = "3: [-1,1)"
    C4 = "5-17: (-Inf,Inf)|{0}"
    C5 = "7-9-10-22: (0,1]"
    C6 = "11: (0, 1/2]"
    C7 = "13-16-19-20: (0,Inf)"
    C8 = "18: [2, Inf)"
    C = c(   C1,  C2,   C3,  C4,   C5,   C6,   C7,  C8 )
    L = c(   -1,   1,   -1,  -B,    0,    0,    0,   2 )
    U = c(    B, 5*B,    1, 5*B,    1,  0.5,    B,   B )
    A = c(  0.5,   2,  0.5,   1,  0.5,  0.2,    1,   3 )
    V = rep(0.01, 20)
    .sliderMenu(refresh.code,
        names       = c("Copula",  "N", C),
        minima      = c(       1,   10, L),
        maxima      = c(      22, 1000, U),
        resolutions = c(       1,   10, V),
        starts      = c(       1,  100, A))
}


# ------------------------------------------------------------------------------


.Kfunc <- 
    function(x, alpha = NULL, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes Density for Archimedean Copulae

    # Arguments:
    #   x - a numeric vector

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Missing x:
    if (missing(x)) x = (0:10)/10

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # Density:
    Kfunc = x - .Phi(x, alpha, type) / .PhiFirstDer(x, alpha, type)

    # Take care from divergencies:
    Kfunc[is.na(Kfunc)] = 0
    Kfunc[x == 1] = 1

    # Return Value:
    Kfunc
}


# ------------------------------------------------------------------------------


.invK <- 
    function(x, alpha = NULL, type = archmList(), lower = 1.0e-8)
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes Inverse of Density for Archimedean Copulae

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Alpha:
    if (is.null(alpha)) alpha = archmParam(type)$param

    # Check alpha:
    check = archmCheck(alpha, type)

    # Compute Inverse:
    .fKC = function(x, p, alpha, type) { .Kfunc (x, alpha, type) - p }
    p = x
    
    z = NULL
    for (P in p) {
        ## alter use to lower to set tolerence else return zero when not exected
        if (P <= .Kfunc(0, alpha, type)) {
            res = 0
        }else{
            res = uniroot(.fKC, c(0, 1),
                          p = P, alpha = alpha, type = type,tol=lower)$root
        }
        
        ## if (P > 1 - lower/2) {
        ##     res = P #1
        ## } else if (P < .Kfunc(0, alpha, type) + lower/2 ) {
        ##     res = 0
        ## } else {
        ##     res = uniroot(.fKC, c(0, 1),
        ##                   p = P, alpha = alpha, type = type,tol=lower)$root
        ## }
        z = c(z, res)
    }

    # Return Value:
    z
}


# ------------------------------------------------------------------------------


.invK2 <- 
    function(x, alpha, type = archmList())
{   
    # A function implemented by Diethelm Wuertz

    # Description:
    #   Computes from tabulated values

    # FUNCTION:

    # Type:
    type = match.arg(type)
    Type = as.integer(type)

    # Tabulated Values:
    iK = NULL
    for (i in 1:length(x)) {
        Ord = order(abs(.Kfunc((0:1000)/1000, alpha, type)-x[i]))[1]/1000
        iK = c(iK, Ord)
    }

    # Return Value:
    iK
}


# ------------------------------------------------------------------------------


.makeConcordanceTable <- 
    function(B = 5, dump = FALSE)
{   
    # A function implemented by Diethelm Wuertz

    # Make Table:
    Counter <- c(1,2,3,2,4,2,5,2,5,5,6,2,7,2,2,7,4,8,7,7,2,5)
    L = c( -1,  +1, -1, -5*B, 0,   0, 0, 2 )
    U = c(  B, 5*B,  1,  5*B, 1, 0.5, B, B )
    Tau = Alpha = Rho = NULL
    for (i in 1:22) {
        print(i)
        No = Counter[i]
        lower = L[No]
        upper = U[No]
        alpha = seq(lower, upper, length = 25)
        Alpha = cbind(Alpha, alpha)
        tau = archmTau(alpha = alpha, type = i)
        rho = archmRho(alpha = alpha, type = i)
        Tau = cbind(Tau, tau)
        Rho = cbind(Rho, rho)
    }
    .ALPHA = data.frame(Alpha)
    .TAU = data.frame(Tau)
    .RHO = data.frame(Rho)
    colnames(.ALPHA) = colnames(.TAU) = colnames(.RHO) = as.character(1:22)

    # Dump:
    if (dump) {
         dump(".ALPHA", "alpha.R")
         dump(".TAU", "tau.R")
         dump(".RHO", "rho.R")
    }

    # Return Value:
    list(ALPHA = .ALPHA, TAU = .TAU, RHO = .RHO)
}


# ------------------------------------------------------------------------------


".ALPHA" <-
    structure(list(

    "1" =
    c(-1, -0.75, -0.5, -0.25, 0, 0.25, 0.5, 0.75, 1, 1.25, 1.5, 1.75,
    2, 2.25, 2.5, 2.75, 3, 3.25, 3.5, 3.75, 4, 4.25, 4.5, 4.75, 5),

    "2" =
    c(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),

    "3" =
    c(-1, -0.916666666666667, -0.833333333333333, -0.75,
    -0.666666666666667, -0.583333333333333, -0.5, -0.416666666666667,
    -0.333333333333333, -0.25, -0.166666666666667, -0.0833333333333334,
    0, 0.0833333333333333, 0.166666666666667, 0.25, 0.333333333333333,
    0.416666666666667, 0.5, 0.583333333333333, 0.666666666666667,
    0.75, 0.833333333333333, 0.916666666666667, 1),

    "4" =
    c(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),

    "5" =
    c(-25, -22.9166666666667, -20.8333333333333, -18.75, -16.6666666666667,
    -14.5833333333333, -12.5, -10.4166666666667, -8.33333333333333,
    -6.25, -4.16666666666666, -2.08333333333333, 0, 2.08333333333334,
    4.16666666666667, 6.25, 8.33333333333334, 10.4166666666667, 12.5,
    14.5833333333333, 16.6666666666667, 18.75, 20.8333333333333,
    22.9166666666667, 25),

    "6" =
    c(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),

    "7" =
    c(0, 0.0416666666666667, 0.0833333333333333, 0.125, 0.166666666666667,
    0.208333333333333, 0.25, 0.291666666666667, 0.333333333333333, 0.375,
    0.416666666666667, 0.458333333333333, 0.5, 0.541666666666667,
    0.583333333333333, 0.625, 0.666666666666667, 0.708333333333333,
    0.75, 0.791666666666667, 0.833333333333333, 0.875, 0.916666666666667,
    0.958333333333333, 1),

    "8" =
    c(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),

    "9" =
    c(0, 0.0416666666666667, 0.0833333333333333, 0.125, 0.166666666666667,
    0.208333333333333, 0.25, 0.291666666666667, 0.333333333333333, 0.375,
    0.416666666666667, 0.458333333333333, 0.5, 0.541666666666667,
    0.583333333333333, 0.625, 0.666666666666667, 0.708333333333333,
    0.75, 0.791666666666667, 0.833333333333333, 0.875, 0.916666666666667,
    0.958333333333333, 1),

    "10" =
    c(0, 0.0416666666666667, 0.0833333333333333, 0.125, 0.166666666666667,
    0.208333333333333, 0.25, 0.291666666666667, 0.333333333333333, 0.375,
    0.416666666666667, 0.458333333333333, 0.5, 0.541666666666667,
    0.583333333333333, 0.625, 0.666666666666667, 0.708333333333333, 0.75,
    0.791666666666667, 0.833333333333333, 0.875, 0.916666666666667,
    0.958333333333333, 1),

    "11" =
    c(0, 0.0208333333333333, 0.0416666666666667, 0.0625, 0.0833333333333333,
    0.104166666666667, 0.125, 0.145833333333333, 0.166666666666667,
    0.1875, 0.208333333333333, 0.229166666666667, 0.25, 0.270833333333333,
    0.291666666666667, 0.3125, 0.333333333333333, 0.354166666666667,
    0.375, 0.395833333333333, 0.416666666666667, 0.4375, 0.458333333333333,
    0.479166666666667, 0.5),

    "12" =
    c(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),

    "13" =
    c(0, 0.208333333333333, 0.416666666666667, 0.625, 0.833333333333333,
    1.04166666666667, 1.25, 1.45833333333333, 1.66666666666667, 1.875,
    2.08333333333333, 2.29166666666667, 2.5, 2.70833333333333,
    2.91666666666667, 3.125, 3.33333333333333, 3.54166666666667, 3.75,
    3.95833333333333, 4.16666666666667, 4.375, 4.58333333333333,
    4.79166666666667, 5),

    "14" = c(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),

    "15" =
    c(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),

    "16" =
    c(0, 0.208333333333333, 0.416666666666667, 0.625, 0.833333333333333,
    1.04166666666667, 1.25, 1.45833333333333, 1.66666666666667, 1.875,
    2.08333333333333, 2.29166666666667, 2.5, 2.70833333333333,
    2.91666666666667, 3.125, 3.33333333333333, 3.54166666666667, 3.75,
    3.95833333333333, 4.16666666666667, 4.375, 4.58333333333333,
    4.79166666666667, 5),

    "17" =
    c(-25, -22.9166666666667, -20.8333333333333, -18.75, -16.6666666666667,
    -14.5833333333333, -12.5, -10.4166666666667, -8.33333333333333,
    -6.25, -4.16666666666666, -2.08333333333333, 0, 2.08333333333334,
    4.16666666666667, 6.25, 8.33333333333334, 10.4166666666667,
    12.5, 14.5833333333333, 16.6666666666667, 18.75, 20.8333333333333,
    22.9166666666667, 25),

    "18" =
    c(2, 2.125, 2.25, 2.375, 2.5, 2.625, 2.75, 2.875, 3, 3.125, 3.25,
    3.375, 3.5, 3.625, 3.75, 3.875, 4, 4.125, 4.25, 4.375, 4.5, 4.625,
    4.75, 4.875, 5),

    "19" =
    c(0, 0.208333333333333, 0.416666666666667, 0.625,
    0.833333333333333, 1.04166666666667, 1.25, 1.45833333333333,
    1.66666666666667, 1.875, 2.08333333333333, 2.29166666666667,
    2.5, 2.70833333333333, 2.91666666666667, 3.125, 3.33333333333333,
    3.54166666666667, 3.75, 3.95833333333333, 4.16666666666667,
    4.375, 4.58333333333333, 4.79166666666667, 5),

    "20" =
    c(0, 0.208333333333333, 0.416666666666667, 0.625, 0.833333333333333,
    1.04166666666667, 1.25, 1.45833333333333, 1.66666666666667,
    1.875, 2.08333333333333, 2.29166666666667, 2.5, 2.70833333333333,
    2.91666666666667, 3.125, 3.33333333333333, 3.54166666666667,
    3.75, 3.95833333333333, 4.16666666666667, 4.375, 4.58333333333333,
    4.79166666666667, 5),

    "21" =
    c(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),

    "22" =
    c(0, 0.0416666666666667, 0.0833333333333333, 0.125, 0.166666666666667,
    0.208333333333333, 0.25, 0.291666666666667, 0.333333333333333, 0.375,
    0.416666666666667, 0.458333333333333, 0.5, 0.541666666666667,
    0.583333333333333, 0.625, 0.666666666666667, 0.708333333333333, 0.75,
    0.791666666666667, 0.833333333333333, 0.875, 0.916666666666667,
    0.958333333333333, 1)),

    .Names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11",
        "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22"),

    row.names = c("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"),

    class = "data.frame")


# ------------------------------------------------------------------------------


".TAU" <-
structure(list(

    "1" =
    c(-1, -0.6, -0.333333333333333, -0.142857142857143,
    0, 0.111111111111111, 0.2, 0.272727272727273, 0.333333333333333,
    0.384615384615385, 0.428571428571429, 0.466666666666667, 0.5,
    0.529411764705882, 0.555555555555556, 0.578947368421053, 0.6,
    0.619047619047619, 0.636363636363636, 0.652173913043478,
    0.666666666666667, 0.68, 0.692307692307692, 0.703703703703704,
    0.714285714285714
    ),

    "2" =
    c(-1, 0, 0.333333333333333, 0.5, 0.6, 0.666666666666667,
    0.714285714285714, 0.75, 0.777777777777778, 0.8, 0.818181818181818,
    0.833333333333333, 0.846153846153846, 0.857142857142857,
    0.866666666666667, 0.875, 0.88235294117647, 0.888888888888889,
    0.894736842105263, 0.9, 0.904761904761905, 0.909090909090909,
    0.91304347826087, 0.916666666666667, 0.92),

    "3" =
    c(-0.181725814826518, -0.168930151452714, -0.155798192853549,
    -0.142309156210049, -0.128440099024957, -0.114165590552606,
    -0.0994573153156502, -0.0842835904937131, -0.068608772818993,
    -0.0523925219034918, -0.0355888743571007, -0.0181450645517658,
    0, 0.0189177438301371, 0.0386926132325796, 0.0594257680440222,
    0.0812402882884418, 0.104288760957381, 0.128764787039966,
    0.154921339236023, 0.183102048111355, 0.21379958230518,
    0.247780252512751, 0.286418218456134, 0.333333333333333),

    "4" =
    c(0, 0.5, 0.666666666666667, 0.75, 0.8, 0.833333333333333,
    0.857142857142857, 0.875, 0.888888888888889, 0.9, 0.909090909090909,
    0.916666666666667, 0.923076923076923, 0.928571428571429,
    0.933333333333333, 0.9375, 0.941176470588235, 0.944444444444444,
    0.947368421052632, 0.95, 0.952380952380952, 0.954545454545455,
    0.956521739130435, 0.958333333333333, 0.96),

    "5" =
    c(-0.85052757802554, -0.837983233335134, -0.823159712179848,
    -0.805382359321779, -0.78368703586404, -0.756652338202137,
    -0.722109024177686, -0.676626253020113, -0.61461896491917,
    -0.527006789744252, -0.400406496234527, -0.222118698154441,
    0, 0.222118698154449, 0.400406496234539, 0.527006789744276,
    0.614618964919029, 0.676626253020132, 0.722109024177453,
    0.756652338200781, 0.783687035871101, 0.805382359356256,
    0.823159712267863, 0.837983231749698, 0.850527554271354),

    "6" =
    c(0, 0.355065933151777, 0.517962498229816, 0.613705638974404,
    0.677220914237255, 0.722592092430507, 0.756685017415291,
    0.783274098241282, 0.80461673005689, 0.822148933158253,
    0.836832638206725, 0.84932812611196, 0.860110789048376,
    0.869526200860125, 0.877832575748863, 0.885224248904,
    0.891855111133839, 0.897842192832803, 0.903279485909824,
    0.90824351995753, 0.912795085448852, 0.91698501728904,
    0.920858299365945, 0.924445190119985, 0.927779794217425),

    "7" =
    c(1, 0.971927944913947, 0.943246768509585, 0.913923522796783,
    0.88392216030227, 0.853203097878133, 0.821722695867944,
    0.789432631089395, 0.756279135134686, 0.722202059745913,
    0.687133717127867, 0.65099742284623, 0.613705638880109,
    0.575157568479307, 0.535235982291939, 0.493802937831557,
    0.450693855665945, 0.40570906309108, 0.358601253084469,
    0.309055967047944, 0.256659242461756, 0.200839120747762,
    0.140745344631603, 0.0749411953484011, 0),

    "8" =
    c(-1, -0.333333333333333, -0.111111111111111, 0, 0.0666666666666667,
    0.111111111111111, 0.142857142857143, 0.166666666666667,
    0.185185185185185, 0.2, 0.212121212121212, 0.222222222222222,
    0.230769230769231, 0.238095238095238, 0.244444444444444,
    0.25, 0.254901960784314, 0.259259259259259, 0.263157894736842,
    0.266666666666667, 0.26984126984127, 0.272727272727273,
    0.275362318840580, 0.277777777777778, 0.28),

    "9" =
    c(0, -0.0204163452169608, -0.0400596555238257, -0.0590081036085306,
    -0.0773261331388824, -0.0950679058715638, -0.112279639253442,
    -0.129001262402105, -0.145267629233813, -0.161109431296128,
    -0.176553899922191, -0.191625356399165, -0.206345649900960,
    -0.220734510872628, -0.234809839618285, -0.24858794447726,
    -0.262083740255211, -0.275310914946985, -0.288282070892981,
    -0.301008845122611, -0.313502012606631, -0.325771575362601,
    -0.337826839765094, -0.349676483955214, -0.361328616888101),

    "10" =
    c(0, -0.0196066744396921,
    -0.0370221472721557, -0.0525703541709941, -0.0665070136005856,
    -0.0790393052012712, -0.0903383149316412, -0.100547418134766,
    -0.109788190716896, -0.118164725554978, -0.125766872846962,
    -0.132672728007605, -0.138950577833938, -0.144660447061511,
    -0.149855344023087, -0.154582275706178, -0.158883083359664,
    -0.162795136572255, -0.166351914405464, -0.16958349544035,
    -0.172516973673804, -0.175176813539516, -0.177585154568996,
    -0.179762074101597, -0.181725814826518),

    "11" =
    c(0, -0.0208398943709387,
    -0.0417175967562695, -0.0626672066307008, -0.083719725295789,
    -0.104903822366714, -0.126246401393688, -0.147773031839223,
    -0.169508288800322, -0.191476027240807, -0.213699608737601,
    -0.236202093256811, -0.259006404912340, -0.282135478276679,
    -0.305612390180847, -0.329460480799121, -0.353703467003579,
    -0.378365550391214, -0.403471521964720, -0.429046865142757,
    -0.455117858555391, -0.481711679925032, -0.50885651222745,
    -0.536581653261374, -0.564917629721708),

    "12" =
    c(0.333333333333333, 0.666666666666667, 0.777777777777778,
    0.833333333333333, 0.866666666666667, 0.888888888888889,
    0.904761904761905, 0.916666666666667, 0.925925925925926,
    0.933333333333333, 0.93939393939394, 0.944444444444444,
    0.948717948717949, 0.952380952380952, 0.955555555555556,
    0.958333333333333, 0.96078431372549, 0.962962962962963,
    0.964912280701754, 0.966666666666667, 0.968253968253968,
    0.96969696969697, 0.971014492753623, 0.972222222222222,
    0.973333333333333),

    "13" =
    c(-0.3613289, -0.269528030161219, -0.187585190523704,
    -0.114164377378166, -0.048139718340646, 0.0114414518639374,
    0.0653882965033201, 0.114390646561491, 0.159038737349337,
    0.199839382405940, 0.237229274320303, 0.271585960700895,
    0.303236932556452, 0.332467174993497, 0.359525461142416,
    0.384629615561405, 0.407970929923072, 0.42971787915222,
    0.450019258484065, 0.469006839692804, 0.486797626862941,
    0.503495777648588, 0.519194244288641, 0.533976179166497,
    0.547916141985897),

    "14" =
    c(0.333333333333333, 0.6, 0.714285714285714, 0.777777777777778,
    0.818181818181818, 0.846153846153846, 0.866666666666667,
    0.88235294117647, 0.894736842105263, 0.904761904761905,
    0.91304347826087, 0.92, 0.925925925925926, 0.93103448275862,
    0.935483870967742, 0.93939393939394, 0.942857142857143,
    0.945945945945946, 0.948717948717949, 0.951219512195122,
    0.953488372093023, 0.955555555555556, 0.957446808510638,
    0.959183673469388, 0.96078431372549),

    "15" =
    c(-1, 0.333333333333333, 0.6, 0.714285714285714,
    0.777777777777778, 0.818181818181818, 0.846153846153846,
    0.866666666666667, 0.88235294117647, 0.894736842105263,
    0.904761904761905, 0.91304347826087, 0.92, 0.925925925925926,
    0.93103448275862, 0.935483870967742, 0.93939393939394,
    0.942857142857143, 0.945945945945946, 0.948717948717949,
    0.951219512195122, 0.953488372093023, 0.955555555555556,
    0.957446808510638, 0.959183673469388),

    "16" =
    c(-1, 0.0199469096156091,
    0.129575836560517, 0.180662881950351, 0.210821233719316,
    0.230868290892863, 0.245206353296857, 0.255989120788036,
    0.264401763304115, 0.271152717969063, 0.276692429117510,
    0.281321400174802, 0.285247984614676, 0.288621292351708,
    0.291550902234041, 0.294119177987248, 0.296389240808115,
    0.298410289410793, 0.300221244635643, 0.301853304387547,
    0.303331771457812, 0.304677385016165, 0.305907306382662,
    0.307035859574841, 0.308075095038758),

    "17" =
    c(-0.505322479883461,
    -0.495828713697966, -0.48454639378008, -0.470935203584076,
    -0.454226630515362, -0.433303941761343, -0.406516652894873,
    -0.371413076160088, -0.324429660012302, -0.26078346047423,
    -0.175313467887867, -0.0654880362471264, 3, 0.198425450290705,
    0.322606327311886, 0.426990238062425, 0.510371695749375,
    0.575835676725875, 0.627386508234144, 0.668494514582698,
    0.701798032118806, 0.729213683422655, 0.752120712677402,
    0.771518248976997, 0.78813985427463),

    "18" =
    c(0.333333333333333, 0.372549019607843, 0.407407407407407,
    0.43859649122807, 0.466666666666667, 0.492063492063492,
    0.515151515151515, 0.536231884057971, 0.555555555555556,
    0.573333333333333, 0.58974358974359, 0.604938271604938,
    0.619047619047619, 0.632183908045977, 0.644444444444444,
    0.655913978494624, 0.666666666666667, 0.676767676767677,
    0.686274509803922, 0.695238095238095, 0.703703703703704,
    0.711711711711712, 0.719298245614035, 0.726495726495726,
    0.733333333333333),

    "19" =
    c(0, 0.429836470415013, 0.492561142661991,
    0.539699842175544, 0.577243238619945, 0.608200347675897,
    0.634340746150618, 0.656827513885057, 0.676426663266239,
    0.693706733577166, 0.709084640531406, 0.722877931761809,
    0.735333844361156, 0.746648476889695, 0.756979782729611,
    0.766456689701118, 0.775185755847842, 0.783255888758933,
    0.790741999213658, 0.797707696363886, 0.80420742554753,
    0.810288035370101, 0.815990188618369, 0.821349301247486,
    0.826396408325272),

    "20" =
    c(0.333333333333333, 0.187581702849446, 0.336923464258114,
    0.453621153661734, 0.544347004922251, 0.615306486593428,
    0.671462346739915, 0.716591196240161, 0.753556906539465,
    0.784548776018356, 0.811245341187264, 0.834925230324345,
    0.856550987713366, 0.87682562788058, 0.896293707460173,
    0.915293066771852, 0.934084281673088, 0.952832982671359,
    0.97164182521641, 0.99056793780414, 1.00963608457645,
    1.02884861875661, 1.04819318064612, 1.06764664223826,
    1.0871818991606),

    "21" =
    c(-0.9999999996, 0.227411277761033, 0.475707247837903,
    0.594420704044238, 0.666780283574186, 0.716296479239256,
    0.752597708588034, 0.780474107458171, 0.80263551556664,
    0.820709018127606, 0.835799583394556, 0.848581734688507,
    0.859631891238008, 0.869228393597159, 0.877745364348898,
    0.885267593021253, 0.8921031172938, 0.89816522529609,
    0.903767761397344, 0.908803416914886, 0.913503328379058,
    0.917746442778645, 0.921749156268669, 0.925374342563027,
    0.92882540945077),

    "22" =
    c(8.88178419700125e-16, -0.0204403642205317, -0.0402325966459149,
    -0.0595398315924127, -0.0784852878388032, -0.09716610551268,
    -0.115661428244375, -0.134037489701166, -0.152350993933844,
    -0.170651459100329, -0.18898289917049, -0.207385066034675,
    -0.225894390250444, -0.244544709719205, -0.263367845858735,
    -0.282394068127122, -0.301652475612564, -0.321171316316645,
    -0.340978259249309, -0.361100630626295, -0.381565622756077,
    -0.402400482266088, -0.423632682913976, -0.445290087203517,
    -0.467401100271068)),

    .Names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11",
        "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22"),

    row.names = c("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"),

    class = "data.frame")


# ------------------------------------------------------------------------------


".RHO" <-
structure(list(
    
    "1" =
        c(-1.00148148148148, -0.738747613322986, -0.466622048681987,
          -0.211687707079451, 0, 0.165652020595619, 0.294857841987463,
          0.396806275669875, 0.478390117460797, 0.544587799346395,
          0.598994031361846, 0.644231561135091, 0.682240753560612,
          0.714478294671625, 0.742053406185035, 0.765822053649082,
          0.786452951364207, 0.80447447147138, 0.820308460074897,
          0.83429494974631, 0.846710452420334, 0.85778166343474,
          0.867695842924806, 0.876608762194626, 0.884650845307784),
    
    "2" =
        c(-1.00148148148148, 0.141567825309872, 0.533448886027939,
          0.708244460527527, 0.800738510405266, 0.855438151990562,
          0.89038551287057, 0.913977650156251, 0.930840822487669,
          0.943140720229384, 0.952367340916965, 0.959636846016786,
          0.965337805120064, 0.969884351339425, 0.973637657583298,
          0.976727483348096, 0.979298582357153, 0.98146084822125,
          0.983296560480555, 0.984868310083549, 0.986245587058835,
          0.987459252328268, 0.988521705438795, 0.989457189777394,
          0.990285276373145),
    
    "3" =
        c(-0.271064557642169, -0.252157028402899, -0.232714526887962,
          -0.212705548849901, -0.19209555265805, -0.170846533523001,
          -0.148916516723668, -0.12625894982673, -0.102821967656877,
          -0.078547495149129, -0.0533701410712804, -0.0272158181938728,
          1.38263885937115e-18, 0.0283745141601889, 0.0580205123349336,
          0.0890702417932126, 0.121680672987631, 0.156040852661039,
          0.192382519137300, 0.230996069414554, 0.272255880785214,
          0.316663434022027, 0.36492869505212, 0.418151365908671,
          0.478390117460797),
    
    "4" =
        c(1.38263885937115e-18, 0.682189978639204, 0.848820654347913,
          0.912515206140176, 0.943205695413621, 0.960245155358946,
          0.970657019434397, 0.977474770619668, 0.982178751195054,
          0.985559960479453, 0.98807177913133, 0.989989026203176,
          0.99148606893177, 0.99267782385585, 0.993642497101149,
          0.994434794399345, 0.99509390407114, 0.995648488592752,
          0.996119899908012, 0.996524305455528, 0.99687412690816,
          0.997179034157432, 0.99744664490479, 0.997683025382027,
          0.997893054234396),
    
    "5" =
        c(-0.972111584358926, -0.967209491068637, -0.960903114161494,
          -0.952607108183223, -0.941402673140619, -0.925789337989117,
          -0.903206982408158, -0.869086491837814, -0.814968529644537,
          -0.725140930480804, -0.573066256464247, -0.328659597722,
          1.38263885937115e-18, 0.328659597722, 0.573066256464246,
          0.725140930480804, 0.814968529644528, 0.86908649183787,
          0.903206982408021, 0.92578933798917, 0.941402673149305,
          0.95260710822185, 0.960903114203512, 0.967209491448638,
          0.972111584081945),
    
    "6" =
        c(1.38263885937115e-18, 0.504193253656214, 0.700093384009142,
          0.798178467968907, 0.854636457142996, 0.890208596051013,
          0.914104060707307, 0.930945457506372, 0.943268127871861,
          0.952561541134428, 0.95968871558049, 0.966247582643763,
          0.970782114931405, 0.976498903835584, 0.979560788569006,
          0.98205552457824, 0.993861933959956, 0.99558219645679,
          1.00597796784080, 1.00765676774247, 1.03633645236535,
          1.03732862637663, 1.03805548919961, 1.05932394767550,
          1.06079424267615),
    
    "7" =
        c(-1.00148148148148, -0.979072702331951, -0.956663923182448,
          -0.934255144032922, -0.910476817558297, -0.885980795610422,
          -0.86087901234568, -0.834111385459534, -0.806575582990396,
          -0.777481481481482, -0.747489711934157, -0.715582990397804,
          -0.682232098765431, -0.646978326474623, -0.60966803840878,
          -0.570271604938272, -0.528215089163238, -0.482955281207133,
          -0.434469135802469, -0.381630727023320, -0.323950617283951,
          -0.259980246913580, -0.187865020576132, -0.104024142661180,
          1.38263885937115e-18),
    
    "8" =
        c(-1.00148148148148, -0.382286405036925, -0.114601585715482,
          0.0310996982933278, 0.121547108159812, 0.182711347208507,
          0.226564943368020, 0.259498634290694, 0.28500277910381,
          0.305383082451978, 0.321951896975906, 0.335684240420725,
          0.347297689031008, 0.35716340065043, 0.365682214112401,
          0.373072635634355, 0.379610561045101, 0.385393549400538,
          0.390535446981844, 0.395136786179741, 0.399301204243857,
          0.403072768984719, 0.406501170036244, 0.409631031685417,
          0.412499583816874),
    
    "9" =
        c(0, -0.0306009955864517, -0.0600171715566712, -0.0883435022143309,
          -0.115662851324462, -0.14204808424762, -0.167563722488530,
          -0.192267256145817, -0.216210197252217, -0.239438934387163,
          -0.261995433039874, -0.283917814885177, -0.305240840989756,
          -0.325996318037027, -0.346213442292882, -0.365919092784125,
          -0.385138082715462, -0.403893376291347, -0.422206276681155,
          -0.440096589759673, -0.457582767389748, -0.474682033331841,
          -0.4914104943232, -0.507783238435509, -0.523814422470025),
    
    "10" =
        c(0, -0.029390926055108, -0.0554838410175942, -0.0787567884244303,
          -0.0995948147001642, -0.118312849424028, -0.135171965480742,
          -0.150391128987132, -0.164155854619207, -0.176624701885803,
          -0.187934236009538, -0.198202876118343, -0.207533922658104,
          -0.216017969401489, -0.223734847121171, -0.230755205988202,
          -0.237141815823774, -0.24295064350982, -0.248231752581214,
          -0.253030059585575, -0.257385974070141, -0.261335943265486,
          -0.264912918148678, -0.268146754209015, -0.271064557642169),
    
    "11" =
        c(0, -0.0312337307463261, -0.0624885635341056, -0.0937774571924054,
          -0.125109119631511, -0.156488211337586, -0.187915529826987,
          -0.219388201730151, -0.250899897834131, -0.282441141124533,
          -0.313999597626781, -0.345560474009285, -0.377106883941072,
          -0.408620285268396, -0.440080745221534, -0.471467680629385,
          -0.502759810642414, -0.533935835408547, -0.564973896022694,
          -0.595854502689236, -0.626555877382724, -0.657058974751787,
          -0.687347683323, -0.717399152001416, -0.747202834006994),
    
    "12" =
        c(0.478390117460797, 0.847457484412861, 0.929514118116192,
          0.959770189940577, 0.974091289816988, 0.98196494553155,
          0.98674930920016, 0.989872618006014, 0.992024786623663,
          0.99357184100672, 0.994722476491513, 0.995602679183581,
          0.99629212083331, 0.996843164325584, 0.99729136172679,
          0.99766153224032, 0.997971424587865, 0.998234001133303,
          0.998458905801764, 0.998653432689402, 0.998823180355318,
          0.998972503148868, 0.99910482845359, 0.99922288351134,
          0.999328860123071),
    
    "13" =
        c(8.60444444444445, -0.396927340010433, -0.279041044592502,
          -0.170790656731972, -0.0721889092723266, 0.0171559644885065,
          0.0978612488308676, 0.170645482690321, 0.236250585187531,
          0.295396788789730, 0.34875879445432, 0.396954947814539,
          0.440544088483541, 0.480026728592929, 0.515848521579894,
          0.548404801961588, 0.578045482558421, 0.605079904444685,
          0.629781421965416, 0.652391617354311, 0.673124105746233,
          0.692167929492244, 0.709690561612045, 0.725840548723069,
          0.740749828053321),
    
    "14" =
        c(0.478390117460797, 0.78697038487367, 0.88669651583035,
          0.930158273783357, 0.952781313104883, 0.966001646844378,
          0.97438037870724, 0.98001921761715, 0.983993663292466,
          0.98689971728531, 0.989089008338032, 0.990779746538743,
          0.992113107410875, 0.99318367420424, 0.99405672549771,
          0.994778481699574, 0.995382405409204, 0.995893200807138,
          0.996329424259493, 0.996705230895822, 0.9970315690086,
          0.997317013020675, 0.99756835474172, 0.997791029818825,
          0.997989429828517),
    
    "15" =
        c(-1.00148148148148, 0.483330421553014, 0.788592827249555,
          0.887213491121673, 0.930351139068034, 0.952863855394297,
          0.966040941166183, 0.974400661352683, 0.980030344652669,
          0.984000050201677, 0.98690350529195, 0.989091305340107,
          0.990781156959334, 0.992113975575947, 0.993184203332592,
          0.99405703905789, 0.994778656516628, 0.995382490232112,
          0.99589322707115, 0.996329412502773, 0.996705194678632,
          0.9970315173572, 0.997316951978555, 0.997568288369395,
          0.997790960846676),
    
    "16" =
        c(-1.00148148148148,
          0.0399918107572716, 0.196922447742505, 0.269217972641498,
          0.311479910536255, 0.339361834072764, 0.359187127162052,
          0.374027186155748, 0.385561510047341, 0.394788531585647,
          0.402340078994373, 0.408635928417183, 0.41396608392397,
          0.418537431930041, 0.422501583532575, 0.425972210130218,
          0.429036230512499, 0.431761254762484, 0.434200670669304,
          0.436397200953502, 0.438385442597004, 0.440193712932073,
          0.441845413865275, 0.443360054973381, 0.444754031079707),
    
    "17" =
        c(-0.644683937053512,
          -0.638242233699325, -0.63002248705626, -0.619327391403488,
          -0.605102498262373, -0.585717699732245, -0.558611529498344,
          -0.519748499835421, -0.462935375218991, -0.379451494373527,
          -0.259494676315209, -0.0980201065759068, -2.86814814814815,
          0.294555695013013, 0.469764827999549, 0.606508141811551,
          0.705924049580753, 0.776198676767287, 0.825867405611722,
          0.86149149285161, 0.887580315101809, 0.907115201815617,
          0.922057497657996, 0.933711847666972, 0.942961892529542),
    
    "18" =
        c(0.579165030761005, 0.612486124687689, 0.641987920637447,
          0.668204867084776, 0.691471975626513, 0.712672417787934,
          0.731485428240074, 0.748541425177017, 0.763998843765579,
          0.7781439158238, 0.79107000000924, 0.802825120690881,
          0.81347401988651, 0.823349095595444, 0.832637848646758,
          0.841114775574677, 0.848922542682376, 0.85620758378877,
          0.862952434000152, 0.869158594153996, 0.87492608635104,
          0.880415774029804, 0.885630004240057,
          0.890455816493047, 0.894963682434538),
    
    "19" =
        c(0.478390117460797, 0.593310952911897, 0.663998561233565,
          0.71419945722106, 0.752174890526936, 0.782049472476609,
          0.806205285404551, 0.826145083754451, 0.842875473608911,
          0.857101027367348, 0.869331955302181, 0.87994792140256,
          0.889237849471334, 0.897425790062242, 0.904688304851229,
          0.911166484840908, 0.916974461375408, 0.922205560262668,
          0.926936833441981, 0.931232450014748, 0.935146270324233,
          0.938723825147773, 0.942003855222286, 0.9450195214372,
          0.947799365319983),
    
    "20" =
        c(0, 0.276598221109225, 0.480091816919932, 0.62207813892774,
          0.720105357077801, 0.788404490421694, 0.83684648649206,
          0.871903512170082, 0.897785391284217, 0.917254967437719,
          0.932155415374907, 0.94373844195542, 0.952871658197302,
          0.960166062946691, 0.96606101324546, 0.970874376612312,
          0.974843755028167, 0.978145796062885, 0.98091616915103,
          0.983256097985314, 0.985247325406535, 0.986952155066644,
          0.988421752891467, 0.98969341361155, 0.990800873367999),
    
    "21" =
        c(-1.00148148148148, 0.347129116118547, 0.65564069685479,
          0.780803624460825, 0.846443027861398, 0.885838814250034,
          0.911560842980429, 0.929365274007805, 0.942234840854385,
          0.951833301777067, 0.96008770231504, 0.965881283889428,
          0.97252949040583, 0.97634531326702, 0.979070799707118,
          0.99154650629721, 0.993599496406914, 1.00432643751157,
          1.00555767252712, 1.03505473383290, 1.03618596470961,
          1.05759086565101, 1.05873221403231, 1.11481166665537,
          1.11507652990229),
    
    "22" =
        c(0, -0.0306367173028787, -0.0602746511903028,
          -0.0891338848924438, -0.117379804930934, -0.145140408516369,
          -0.172516725392443, -0.199589475575909, -0.226423523248459,
          -0.253070965533168, -0.279573384360126, -0.30596355638433,
          -0.332266726350362, -0.358501732266778, -0.384681876941774,
          -0.410815779550173, -0.436907762333632, -0.462959276965944,
          -0.488968041367581, -0.514929666432483, -0.540839175128809,
          -0.566687136331552, -0.592466001518449, -0.618164814543992,
          -0.643774208533738)),
    
    .Names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11",
        "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22"),
    
    row.names = c("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"),
    
    class = "data.frame")


################################################################################

Try the fCopulae package in your browser

Any scripts or data that you put into this service are public.

fCopulae documentation built on Dec. 29, 2022, 4:03 p.m.