hc4wmc:

In musto101/wilcox_R: What the package does (short line)

Usage

hc4wmc(x, y, nboot = 599, k = 2, grp = NA, con = 0, SEED = TRUE, STOP = TRUE, ...)

Arguments

x
y
nboot
k
grp
con
SEED
STOP
...

Examples

##---- 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 = 599, k = 2, grp = NA, con = 0, SEED = TRUE, 
    STOP = TRUE, ...) 
{
    if (STOP) 
        stop("Suggest ols1way. This function assumes equal n. To use anyway, set STOP=FALSE")
    con <- as.matrix(con)
    if (is.matrix(x)) 
        x <- listm(x)
    if (!is.list(x)) 
        stop("Data must be stored in list mode or in matrix mode.")
    if (is.matrix(y)) 
        y <- listm(y)
    if (!is.list(y)) 
        stop("Data must be stored in list mode or in matrix mode.")
    if (!is.na(sum(grp))) {
        xx <- list()
        yy <- list()
        for (i in 1:length(grp)) xx[[i]] <- x[[grp[i]]]
        yy[[i]] <- y[[grp[i]]]
        x <- xx
        y <- yy
    }
    J <- length(x)
    n <- length(x[[1]])
    tempn <- 0
    slopes <- NA
    covar <- NA
    stemp <- NA
    yhat <- numeric(J)
    res <- matrix(, ncol = J, nrow = n)
    for (j in 1:J) {
        temp <- cbind(x[[j]], y[[j]])
        temp <- elimna(temp)
        tempn[j] <- length(temp)
        x[[j]] <- temp[, 1]
        y[[j]] <- temp[, 2]
        tempx <- as.matrix(x[[j]])
        tempy <- as.matrix(y[[j]])
        yhat[j] <- mean(tempy)
        res[, j] <- tempy - yhat[j]
        stemp <- lsfit(tempx, tempy)
        slopes[j] <- stemp$coef[k]
        covar[j] <- lsfitNci4(tempx, tempy)$cov[k, k]
    }
    Jm <- J - 1
    if (sum(con^2) == 0) {
        ncon <- (J^2 - J)/2
        con <- matrix(0, J, ncon)
        id <- 0
        for (j in 1:Jm) {
            jp <- j + 1
            for (h in jp:J) {
                id <- id + 1
                con[j, id] <- 1
                con[h, id] <- 0 - 1
            }
        }
    }
    ncon <- ncol(con)
    if (nrow(con) != J) {
        stop("Something is wrong with con; the number of rows does not match the number of groups.")
    }
    dif.slopes <- t(con) %*% slopes
    o.se <- t(con^2) %*% covar
    o.stat <- dif.slopes/sqrt(o.se)
    om <- max(abs(o.stat))
    if (SEED) 
        set.seed(2)
    data <- matrix(ifelse(rbinom(n * nboot * J, 1, 0.5) == 1, 
        -1, 1), ncol = nboot * J)
    test <- numeric(nboot)
    u <- rep(1, n)
    c <- 1
    for (i in 1:nboot * J - J + 1) {
        d <- data[, i:i + J - 1]
        ystar <- u %*% t(yhat) + res * d
        ystar <- listm(ystar)
        i <- i + J
        test[c] <- mcslope(x, ystar, con, k)
        c <- c + 1
    }
    sum <- sum(test >= om)
    p.val <- sum/nboot
    list(p.value = p.val)
  }

musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.