1 |
x |
|
y |
|
nboot |
|
SEED |
|
RAD |
|
xout |
|
outfun |
|
... |
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 | ##---- 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, nboot = 500, SEED = TRUE, RAD = TRUE, xout = FALSE,
outfun = outpro, ...)
{
if (SEED)
set.seed(2)
x <- as.matrix(x)
temp <- cbind(x, y)
temp <- elimna(temp)
pval <- ncol(temp) - 1
x <- temp[, 1:pval]
y <- temp[, pval + 1]
if (xout) {
flag <- outfun(x, ...)$keep
x <- as.matrix(x)
x <- x[flag, ]
y <- y[flag]
x <- as.matrix(x)
}
x <- as.matrix(x)
p <- ncol(x)
pp <- p + 1
temp <- lsfit(x, y)
Rsq = ols(x, y)$R.squared
yhat <- mean(y)
res <- y - yhat
s <- olshc4(x, y)$cov[-1, -1]
si <- solve(s)
b <- temp$coef[2:pp]
wtest <- t(b) %*% si %*% b
if (RAD)
data <- matrix(ifelse(rbinom(length(y) * nboot, 1, 0.5) ==
1, -1, 1), nrow = nboot)
if (!RAD) {
data <- matrix(runif(length(y) * nboot), nrow = nboot)
data <- (data - 0.5) * sqrt(12)
}
rvalb <- apply(data, 1, lstest4, yhat, res, x)
sum <- sum(rvalb >= wtest[1, 1])
p.val <- sum/nboot
list(p.value = p.val, R.squared = Rsq)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.