M2m.loc:

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

Usage

M2m.loc(m, grpc, col.dat, locfun = tmean, ...)

Arguments

m
grpc
col.dat
locfun
...

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 (m, grpc, col.dat, locfun = tmean, ...) 
{
    flagit = F
    if (is.null(dim(m))) 
        stop("Data must be stored in a matrix or data frame")
    if (is.na(grpc[1])) 
        stop("The argument grpc is not specified")
    if (is.na(col.dat[1])) 
        stop("The argument col.dat is not specified")
    if (length(grpc) > 4) 
        stop("grpc must have length <= 4")
    m = as.data.frame(m)
    if (length(grpc) == 1) {
        p1 = ncol(m) + 1
        dum = rep(1, nrow(m))
        flagit = T
        m = cbind(m, dum)
        grpc = c(NULL, gprc, p1)
        cat1 <- sort(unique(m[, grpc[1]]))
        M = NULL
        for (ig1 in 1:length(cat1)) {
            flag1 = (m[, grpc[1]] == cat1[ig1])
            flag = (flag1 == 1)
            msub = as.data.frame(m[flag, ])
            loc = locfun(m[flag, col.dat], ...)
            M = rbind(M, as.data.frame(cbind(msub[1, grpc], loc)))
        }
        M = M[, c(1, 3)]
    }
    if (length(grpc) == 2) {
        cat1 <- sort(unique(m[, grpc[1]]))
        cat2 <- sort(unique(m[, grpc[2]]))
        M = NULL
        for (ig1 in 1:length(cat1)) {
            for (ig2 in 1:length(cat2)) {
                flag1 = (m[, grpc[1]] == cat1[ig1])
                flag2 = (m[, grpc[2]] == cat2[ig2])
                flag = (flag1 * flag2 == 1)
                msub = m[flag, ]
                loc = locfun(m[flag, col.dat], ...)
                M = rbind(M, as.data.frame(cbind(msub[1, grpc], 
                  loc)))
            }
        }
    }
    if (length(grpc) == 3) {
        cat1 <- sort(unique(m[, grpc[1]]))
        cat2 <- sort(unique(m[, grpc[2]]))
        cat3 <- sort(unique(m[, grpc[3]]))
        M = NULL
        for (ig1 in 1:length(cat1)) {
            for (ig2 in 1:length(cat2)) {
                for (ig3 in 1:length(cat3)) {
                  flag1 = (m[, grpc[1]] == cat1[ig1])
                  flag2 = (m[, grpc[2]] == cat2[ig2])
                  flag3 = (m[, grpc[3]] == cat3[ig3])
                  flag = (flag1 * flag2 * flag3 == 1)
                  msub = m[flag, ]
                  loc = locfun(m[flag, col.dat], ...)
                  M = rbind(M, as.data.frame(cbind(msub[1, grpc], 
                    loc)))
                }
            }
        }
    }
    if (length(grpc) == 4) {
        cat1 <- sort(unique(m[, grpc[1]]))
        cat2 <- sort(unique(m[, grpc[2]]))
        cat3 <- sort(unique(m[, grpc[3]]))
        cat4 <- sort(unique(m[, grpc[4]]))
        M = NULL
        for (ig1 in 1:length(cat1)) {
            for (ig2 in 1:length(cat2)) {
                for (ig3 in 1:length(cat3)) {
                  for (ig4 in 1:length(cat4)) {
                    flag1 = (m[, grpc[1]] == cat1[ig1])
                    flag2 = (m[, grpc[2]] == cat2[ig2])
                    flag3 = (m[, grpc[3]] == cat3[ig3])
                    flag4 = (m[, grpc[4]] == cat4[ig4])
                    flag = (flag1 * flag2 * flag3 * flag4 == 
                      1)
                    msub = m[flag, ]
                    loc = locfun(m[flag, col.dat], ...)
                    M = rbind(M, as.data.frame(cbind(msub[1, 
                      grpc], loc)))
                  }
                }
            }
        }
    }
    if (flagit) 
        M = M[, c(1, 3)]
    M
  }

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