R/rr_key.R

Defines functions rr_key_fields rr_key_fields.register rr_key_links rr_key_links.register

Documented in rr_key_fields rr_key_fields.register rr_key_links rr_key_links.register

#' List registers linked to by key fields
#'
#' @description
#' Values in fields with the `"register"` proporty link to other registers.
#' These functions list which registers are linked to by a field or all the
#' fields in a register.
#'
#' [rr_key_fields()] names which fields in a register have the `"register"`
#' properety.
#'
#' [rr_key_links()] names all fields in a register that have the `"register"`
#' property, and the name of the register each one links to.
#'
#' @param x Object of class `"register"`, or a character vector that is a field
#' of a register object (`register$data$foo`) with the `"register"` property.
#'
#' @return A character vector of names of registers that are linked to.
#' @name rr_key
#' @examples
#' register <- rr_register("allergen")
#' rr_key_fields(register)
#' rr_key_links(register)
NULL

#' @rdname rr_key
#' @export
rr_key_fields <- function(x) {
  UseMethod("rr_key_fields")
}

#' @rdname rr_key
#' @export
rr_key_fields.register <- function(x) {
  x$schema$fields %>%
  dplyr::filter(!is.na(register), !(register == field)) %>%
  dplyr::pull(field)
}

#' @rdname rr_key
#' @export
rr_key_links <- function(x) {
  UseMethod("rr_key_links")
}

#' @rdname rr_key
#' @export
rr_key_links.register <- function(x) {
  register_name <- rr_snapshot(x)$schema$ids$name
  x$schema$fields %>%
    dplyr::filter(!is.na(register), field != !! register_name) %>%
    dplyr::distinct(field, register)
}
nacnudus/registr documentation built on May 5, 2019, 12:31 p.m.