R/group.R

In inbo/INLA: Full Bayesian Analysis of Latent Gaussian Models using Integrated Nested Laplace Approximations

## Export: inla.group

##!\name{inla.group}
##!\alias{inla.group}
##!
##!\title{Group or cluster covariates}
##!
##!\description{\code{inla.group} group or cluster covariates so to reduce
##!  the number of unique values}
##!\usage{
##!inla.group(x, n = 25, method = c("cut", "quantile"), idx.only = FALSE)
##!}
##!\arguments{
##!
##!  \item{x}{The vector of covariates to group.}
##!  \item{n}{Number of classes or bins to group into.}
##!  \item{method}{Group either using bins with equal length intervals
##!    (\code{method = "cut"}), or equal distance in the `probability'
##!    scale using the quantiles (\code{method = "quantile"}).}
##!  \item{idx.only}{Option to return the index only and not the
##!    \code{method}.}
##!}
##!
##!
##!\value{
##!  \code{inla.group} return the new grouped covariates where the classes
##!  are set to the median of all the covariates belonging to that group.
##!}
##!\author{Havard Rue \email{hrue@r-inla.org}}
##!\seealso{\code{\link{f}}}
##!\examples{
##!## this gives groups 3 and 8
##!x = 1:10
##!x.group = inla.group(x, n = 2)
##!
##!## this is the intended use, to reduce the number of unique values in
##!## the of first argument of f()
##!n = 100
##!x = rnorm(n)
##!y = x + rnorm(n)
##!result = inla(y ~ f(inla.group(x, n = 20), model = "iid"), data=data.frame(y=y,x=x))
##!}

`inla.group` = function(x, n = 25, method = c("cut", "quantile"), idx.only = FALSE)
{
    `inla.group.core` = function(x, n = 25, method = c("cut", "quantile"), idx.only)
    {
        ## group covariates into N groups using method "quantile" or
        ## "cut", i.e., the functions quantile() or cut().  the cut
        ## use 'even length' wheras the 'quantile' use even length
        ## quantiles.

        ## I make the "cut" default, as then we have control over the
        ## minimum distance between each cell, whereas the "quantile"
        ## approach, we do not have a such control.

        if (n < 1)
            stop("Number of groups must be > 0")

        if (n == 1)
            return (rep(median(x), length(x)))

        method = match.arg(method)
        if (method == "cut") {
            ## use equal length
            a = cut(x, n)
        } else {
            ## use break-points corresponding to the quantiles
            aq = unique(quantile(x, probs = c(0, ppoints(n-1), 1)))
            a = cut(x, breaks = as.numeric(aq), include.lowest=TRUE)
        }
        ## the rest is then the same
        nlev = nlevels(a)
        xx = list()
        for(i in 1:nlev)
            xx[[i]] = list()

        for(i in 1:length(x))
            xx[[as.numeric(a[i])]] = c(unlist(xx[[as.numeric(a[i])]]), x[i])
        values = numeric(nlev)

        ff.local = function(xx) {
            if (length(xx) > 0)
                return (median(xx))
            else
                return (NA)
        }
        if (!idx.only) {
            values = unlist(sapply(xx, ff.local))
            return (as.numeric(values[as.numeric(a)]))
        } else {
            return (as.numeric(a))
        }
    }

    if (missing(x))
        return (NULL)

    if (any(is.na(x))) {
        idx.ok = !is.na(x)
        x[idx.ok] = inla.group.core(x[idx.ok], n, method, idx.only)
        return (x)
    } else {
        return (inla.group.core(x, n, method, idx.only))
    }
}

`inla.group.dist` = function(x, dist.min = NULL, dist.min.rel = NULL)
{
    ## form groups based on the distance such that min.distance > dist.min
    if (missing(x))
        return (NULL)
    
    if (any(is.na(x))) {
        idx.ok = !is.na(x)
        x[idx.ok] = inla.group.dist(x[idx.ok], dist.min, dist.min.rel)
        return (x)
    }
    
    if ((is.null(dist.min) && is.null(dist.min.rel)) || (length(x) == 1L)) {
        return (x)
    }
    dist = if (!is.null(dist.min)) dist.min else diff(range(x)) * dist.min.rel
    x.sort = order(x)
    n = length(x)
    xx = x[x.sort]

    ## this is potentially slow...
    i = 1L
    while(i <= n-1) {
        if (xx[i+1L] - xx[i] > 0.0 && xx[i+1L] - xx[i] < 2*dist) {
            k = 2L
            while(i + k <= n && xx[i+k] - xx[i] < 2*dist) {
                k = k + 1L
            }
            idx = i:(i+k-1L)
            xx[idx] = mean(range(xx[idx]))
            i = i + k
        } else {
            i = i + 1L
        }
    }
    xx[x.sort] = xx

    return (xx)
}