Nothing
Lag1 <- function (u, ds, mu)
{
L <- -1 / max(u - mu)
R <- -1 / min(u - mu)
dif <- 1
tol <- 1e-04
while (dif > tol){
M <- (L + R) / 2
glam <- sum((ds * (u - mu)) / (1 + M * (u - mu)))
if (glam > 0) L <- M
if (glam < 0) R <- M
dif <- abs (glam)
}
return (M)
}
Lag2 <- function (u, ds, mu)
{
n <- length (ds)
u <- u - rep (1,n) %*% t(mu)
M <- 0 * mu
dif <- 1
tol <- 1e-04
while (dif > tol){
D1 <- 0 * mu
DD <- D1 %*% t(D1)
for (i in 1:n){
aa <- as.numeric (1 + t(M) %*% u[i,])
D1 <- D1 + ds[i] * u[i,] / aa
DD <- DD - ds[i] * (u[i,] %*% t(u[i,]))/aa^2
}
D2 <- solve (DD, D1, tol = 1e-12)
dif <- max (abs(D2))
rule <- 1
while (rule > 0){
rule <- 0
if (min (1 + t(M - D2) %*% t(u)) <= 0) rule <- rule + 1
if (rule > 0) D2 <- D2 / 2
}
M <- M - D2
}
return (M)
}
PELConfInt = function (a, ys, ds, YEL, nss, ps)
{
res <- rep (0, 2)
#--------------------------------------
tol <- 1e-08
cut <- qchisq(a,1)
#--------------
t1 <- YEL
t2 <- max(ys)
dif <- t2 - t1
while (dif > tol) {
tau <- (t1 + t2) / 2
M <- Lag1 (ys, ds, tau)
elratio <- -2 * nss * (sum(ds * (log(ds) - log (1 + M * (ys - tau)) - log(ps))))
if (elratio > cut) t2 <- tau
if (elratio <= cut) t1 <- tau
dif <- t2 - t1
}
res[1] <- (t1 + t2) / 2
#-------------
t1 <- YEL
t2 <- min(ys)
dif <- t1 - t2
while (dif > tol) {
tau <- (t1 + t2) / 2
M <- Lag1(ys, ds, tau)
elratio <- -2 * nss * (sum(ds * (log(ds) - log (1 + M * (ys - tau)) - log(ps))))
if(elratio > cut) t2 <- tau
if(elratio <= cut) t1 <- tau
dif <- t1 - t2
}
res[2] <- (t1 + t2) / 2
return(res)
}
`print.EstimatorDF`=function(x, ...){
if (is.null(attr(x, "attributesDF")[1])){
cat("\nEstimation:\n")
print(x$Est)
}
else {
cat("\nEstimation and ",attr(x, "attributesDF")[1]*100,"% Confidence Intervals:\n")
print(x$ConfInt)
}
}
`summary.EstimatorDF`=function(object, ...){
cat("\nCall:\n")
print(object$Call)
cat("\nEstimation:\n")
print(object$Est)
if (!is.null(object$VarEst)){
cat("\nVariance Estimation:\n")
print(object$VarEst)
}
if (!is.null(object$TotDomEst)){
cat("\nTotal Domain Estimations:\n")
print(object$TotDomEst)
}
if (!is.null(object$MeanDomEst)){
cat("\nMean Domain Estimations:\n")
print(object$MeanDomEst)
}
if(!is.null(object$Param)){
cat("\nParameters:\n")
print(object$Param)
}
if (!is.null(attr(object, "attributesDF")[1])){
cat("\n",attr(object, "attributesDF")[1]*100,"% Confidence Intervals:\n")
print(object$ConfInt)
}
}
`print.EstimatorMDF`=function(x, ...){
if (is.null(attr(x, "attributesMDF")[1])){
cat("\nEstimation:\n")
print(x$Est)
}
else {
cat("\nEstimation and ",attr(x, "attributesMDF")[1]*100,"% Confidence Intervals:\n")
print(x$ConfInt)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.