R/thin.R

Defines functions thin

Documented in thin

#' Thin data to retain matching linelist / contacts
#'
#' This function can be used to remove ('thin') data from
#' \code{\link{epicontacts}} objects to ensure stricter matching of linelists
#' and contacts. It has two behaviours, triggered by the argument \code{what}:
#' either it thins data from \code{$linelist}, keeping only cases that are in
#' \code{$contacts} (\code{thin = "linelist"}, default), or the converse,
#' i.e. removing contacts which are not fully documented in the linelist.
#'
#' @export
#'
#' @author Thibaut Jombart (\email{[email protected]@gmail.com})
#'
#' @param x An \code{\link{epicontacts}} object.
#'
#' @param what A character string or integer determining which type of data is
#'     removed ('thinned'). "linelist" / 1 indicates that only cases appearing
#'     in \code{$contacts} are kept in \code{$linelist}. "contacts / 2"
#'     indicates that only cases appearing in \code{$linelist} are kept in
#'     \code{$contacts}.
#'
#'
#' @examples
#' if (require(outbreaks)) {
#' ## build data
#' x <- make_epicontacts(ebola_sim$linelist, ebola_sim$contacts,
#'                        id = "case_id", to = "case_id", from = "infector",
#'                        directed = TRUE)
#'
#' ## keep contacts from a specific case '916d0a'
#' x <- x[j = "916d0a", contacts = "from"]
#'
#' }
thin <- function(x, what = "linelist") {
    if (!inherits(x, "epicontacts")) {
        stop("x is not an epicontacts object")
    }

    what <- what[1]
    if (what == "linelist" || what == 1) {
      to_keep <- intersect(get_id(x, "linelist"),
                           get_id(x, "contacts"))
      out <- x[i = to_keep]
    } else if (what == "contacts" || what == 2) {
      to_keep <- intersect(get_id(x, "linelist"),
                           get_id(x, "contacts"))
        out <- x[j = to_keep, contacts = "both"]
    } else {
        msg <- paste0("Wrong values for 'what'; accepted values are:\n",
                      "'linelist', 'contact', 1, 2")
        stop(msg)
    }

    return(out)
}

Try the epicontacts package in your browser

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

epicontacts documentation built on May 2, 2019, 11:29 a.m.