Qfn: Function to compute the criteria values Q.

Usage Arguments Examples

Usage

1
Qfn(X, S, N)

Arguments

X
S
N

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
##---- 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, S, N) 
{
    beta1 <- -1 * (1/(sigma^2))
    dmat <- e2dist(X, S)^2
    lammat <- exp(beta0 + beta1 * dmat)
    lamvec <- exp(beta0 + beta1 * dmat[1:length(dmat)])
    lamJ <- as.vector(t(lammat) %*% rep(1, nrow(X)))
    pbar <- as.vector(1 - exp(-t(lammat) %*% rep(1, nrow(X))))
    pbar <- mean(pbar)
    M1 <- rep(1, ntraps * nrow(S))
    M2 <- dmat[1:length(dmat)]
    I11 <- (1/nrow(S)) * sum(lamvec)
    I12 <- (1/nrow(S)) * sum(lamvec * M2)
    I21 <- (1/nrow(S)) * sum(lamvec * M2)
    I22 <- (1/nrow(S)) * sum(lamvec * M2 * M2)
    I <- matrix(c(I11, I12, I21, I22), nrow = 2, byrow = TRUE)
    I <- N * pbar * I
    V <- solve(I)
    Q1 <- sum(diag(V))
    sumsJ <- as.vector(t(lammat * lammat * (diag(V)[1] + (dmat^2) * 
        diag(V)[2] - 2 * dmat * V[1, 2])) %*% rep(1, nrow(X)))
    var.pbar <- ((1/nrow(S))^2) * sum(exp(-lamJ) * exp(-lamJ) * 
        sumsJ)
    part1 <- (N * N * var.pbar)
    part2 <- N * (1 - pbar)/pbar
    total <- part1 + part2
    newpart2 <- N * (1 - pbar) * (var.pbar + 1)/pbar
    old <- N * N * var.pbar + newpart2
    fixed <- N * pbar * ((1 - pbar) + N * pbar) * (var.pbar/(pbar^4))
    Q1 <- part1
    Q2 <- newpart2
    Q3 <- total
    Q4 <- Q1
    Q5 <- fixed
    Q6 <- 1 - pbar
    Q7 <- var.pbar
    c(Q1, Q2, Q3, Q4, Q5, Q6, Q7)
  }

jaroyle/scrDesign documentation built on June 11, 2019, 6:06 p.m.