R/anesrakefinder.R

anesrakefinder <-
function(inputter, dataframe, weightvec = NULL, 
    choosemethod = "total") {
    if (is.null(weightvec)) {
        weightvec <- rep(1, dim(dataframe)[1])
    }
    findoff <- lapply(names(inputter), function(x) {
        discrep(dataframe[,x], 
                inputter[x][[1]], 
                weightvec)
    })
    names(findoff) <- names(inputter)
    if (choosemethod == "total") {
        out <- sapply(findoff, function(x) {
            x <- sum(abs(x), na.rm = TRUE)
        })
    }
    if (choosemethod == "max") {
        out <- sapply(findoff, function(x) {
            x <- range(abs(x), na.rm = TRUE)[2]
        })
    }
    if (choosemethod == "average") {
        out <- sapply(findoff, function(x) {
            x <- mean(abs(x), na.rm = TRUE)
        })
    }
    if (choosemethod == "totalsquared") {
        out <- sapply(findoff, function(x) {
            x <- sum(x^2, na.rm = TRUE)
        })
    }
    if (choosemethod == "maxsquared") {
        out <- sapply(findoff, function(x) {
            x <- range(x^2, na.rm = TRUE)[2]
        })
    }
    if (choosemethod == "averagesquared") {
        out <- sapply(findoff, function(x) {
            x <- mean(x^2, na.rm = TRUE)
        })
    }
    out
}

Try the anesrake package in your browser

Any scripts or data that you put into this service are public.

anesrake documentation built on May 2, 2019, 1:42 p.m.