format.output: format output

In aasrinivasan/hleaps: Hierarchy Supporting Ordinary Least Squares

Description

Formats hleaps output and calculates returned values based on method selection.

Usage

format.output(minSize, maxSize, nbest, altOut, method, 
              colAssign, dfTotal, mods, numTerms, respVec, 
              startTime, SSTotUnCor, hEnv, weightsOpt, 
              weights = NULL, offsetOpt, offsets = NULL)

Arguments

minSize
maxSize
nbest
altOut
method
colAssign
dfTotal
mods
numTerms
respVec
startTime
SSTotUnCor
hEnv
weights
weightsOpt
offsetOpt
offsets

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 (minSize, maxSize, nbest, altOut, method, colAssign, 
    dfTotal, mods, numTerms, respVec, startTime, SSTotUnCor, 
    hEnv) 
{
    dfModM <- hEnv$dfModM
    SSModM <- hEnv$SSModM
    termsModM <- hEnv$termsModM
    notEmpty <- as.vector(SSModM < Inf)
    size <- rep(1:numTerms, each = nbest)[notEmpty]
    dfMod <- as.vector(dfModM)[notEmpty]
    critValues <- as.vector(SSModM)[notEmpty]
    modId <- as.vector(termsModM)[notEmpty]
    decId <- modId
    modTerms <- matrix(ncol = numTerms, nrow = length(decId))
    for (i in numTerms:1) {
        modTerms[, i] <- decId >= 2^(i - 1)
        decId <- decId - ifelse(modTerms[, i], 2^(i - 1), 0)
    }
    termsMatrix <- modTerms
    if (0 %in% colAssign) {
        SSTotal <- sum((as.numeric(respVec) - mean(as.numeric(respVec)))^2)
        dfTotal2 <- length(respVec) - 1
    }
    else {
        SSTotal <- SSTotUnCor
        dfTotal2 <- length(respVec)
    }
    if (method == "r2") {
        critValueCor <- 1 - critValues/SSTotal
    }
    else if (method == "adjr2") {
        critValueCor <- 1 - critValues * (dfTotal2/SSTotal)
    }
    else if (method == "AIC") {
        critValueCor <- critValues + log(1/dfTotal)
    }
    else if (method == "BIC") {
        critValueCor <- critValues + log(1/dfTotal)
    }
    else if (method == "RSS") {
        critValueCor <- critValues
    }
    ModCriteria <- critValueCor
    o <- sort(critValues)
    modOrder <- match(critValues, o)
    uSizes <- unique(size)
    for (i in 1:length(uSizes)) {
        thisSize <- which(size == uSizes[i])
        thisSSMod <- critValueCor[thisSize]
        thisDecSS <- order(thisSSMod, decreasing = TRUE)
        orderModOrder <- modOrder[thisSize]
        modOrder[thisSize] <- orderModOrder[thisDecSS]
        orderdfMod <- dfMod[thisSize]
        dfMod[thisSize] <- orderdfMod[thisDecSS]
        orderCrit <- critValueCor[thisSize]
        ModCriteria[thisSize] <- orderCrit[thisDecSS]
        orderThis <- termsMatrix[thisSize, ]
        if (length(thisDecSS) > 1) {
            termsMatrix[thisSize, ] <- orderThis[thisDecSS, ]
        }
    }
    if (!altOut) {
        colnames(termsMatrix) <- as.character(seq(1:ncol(termsMatrix)))
        rownames(termsMatrix) <- as.character(size)
        label <- colnames(mods)
        if (0 %in% colAssign) {
            label <- c("(Intercept)", label)
        }
        BSS <- list(which = termsMatrix, label = label, size = size, 
            method = ModCriteria)
        names(BSS)[names(BSS) == "method"] <- method
    }
    else {
        comp.mod <- format.subsets(termsMatrix)
        totalTime <- proc.time()[3] - startTime[3]
        time.usage <- paste("Total number of model subsets examined was ", 
            hEnv$numSets, " Total run time was ", format(totalTime, 
                trim = FALSE, digits = 7), " seconds.")
        modelInfo <- cbind(size, df = dfMod, order = modOrder, 
            method = ModCriteria, comp.mod)
        colnames(modelInfo)[colnames(modelInfo) == "method"] <- method
        BSS <- list(modelInfo = modelInfo, label = colnames(mods), 
            executionInfo = time.usage)
    }
    return(BSS)
  }

aasrinivasan/hleaps documentation built on May 10, 2019, 4:05 a.m.