Nothing
#' Learn about your data model
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' This function returns a tibble with information about
#' the cardinality of the FK constraints.
#' The printing for this object is special, use [as_tibble()]
#' to print as a regular tibble.
#'
# Can't @inheritParams dm_examine_constraints for some reason
#' @param .dm A `dm` object.
#' @inheritParams rlang::args_dots_empty
#' @param .progress Whether to display a progress bar, if `NA` (the default)
#' hide in non-interactive mode, show in interactive mode. Requires the
#' 'progress' package.
#' @param dm,progress `r lifecycle::badge("deprecated")`
#'
#' @return A tibble with the following columns:
#' \describe{
#' \item{`child_table`}{child table,}
#' \item{`child_fk_cols`}{foreign key column(s) in child table as list of character vectors,}
#' \item{`parent_table`}{parent table,}
#' \item{`parent_key_cols`}{key column(s) in parent table as list of character vectors,}
#' \item{`cardinality`}{the nature of cardinality along the foreign key.}
#' }
#'
#' @details Uses [examine_cardinality()] on each foreign key that is defined in the [`dm`].
#'
#' @family cardinality functions
#'
#' @export
#' @examplesIf rlang::is_installed("nycflights13")
#' dm_nycflights13() %>%
#' dm_examine_cardinalities()
dm_examine_cardinalities <- function(.dm, ..., .progress = NA,
dm = deprecated(), progress = deprecated()) {
check_dots_empty()
if (!is_missing(dm)) {
deprecate_soft("1.0.0", "dm_examine_cardinalities(dm = )", "dm_examine_cardinalities(.dm = )")
}
if (is_missing(.dm)) {
return(dm_examine_cardinalities(dm, .progress = .progress, progress = progress))
}
if (!is_missing(progress)) {
if (is.na(progress)) {
progress <- .progress
}
deprecate_soft("1.0.0", "dm_examine_cardinalities(progress = )", "dm_examine_cardinalities(.progress = )")
}
check_not_zoomed(.dm)
.dm %>%
dm_examine_cardinalities_impl(progress = .progress, top_level_fun = "dm_examine_cardinalities") %>%
new_dm_examine_cardinalities()
}
#' @autoglobal
dm_examine_cardinalities_impl <- function(dm, progress = NA, top_level_fun = NULL) {
fks <-
dm_get_all_fks_impl(dm) %>%
select(-on_delete)
dm_def <- as.list(dm)
fks_data <-
fks %>%
transmute(
x_label = parent_table,
y_label = child_table,
x = map2(dm_def[x_label], parent_key_cols, ~ select(.x, all_of(.y))),
y = map2(dm_def[y_label], child_fk_cols, ~ select(.x, all_of(.y))),
)
ticker <- new_ticker(
"checking fk cardinalities",
n = nrow(fks),
progress = progress,
top_level_fun = top_level_fun
)
fks %>%
mutate(cardinality = pmap_chr(fks_data, ticker(examine_cardinality_impl0)))
}
new_dm_examine_cardinalities <- function(x) {
class(x) <- c("dm_examine_cardinalities", class(x))
x
}
#' @export
print.dm_examine_cardinalities <- function(x, ...) {
if (nrow(x) == 0) {
cli::cli_alert_warning("No FKs available in `dm`.")
return(invisible(x))
}
x %>%
mutate(
cardinalities =
pmap_chr(
x,
function(parent_table, parent_key_cols, child_table, child_fk_cols, cardinality) {
paste0(
"FK: ",
child_table,
"$(",
commas(tick(child_fk_cols)),
") -> ",
parent_table,
"$(",
commas(tick(parent_key_cols)),
"): ",
cardinality
)
}
)
) %>%
bullets_cardinalities()
}
#' @autoglobal
bullets_cardinalities <- function(x) {
x <- mutate(
x,
col = if_else(grepl("mapping", cardinality), "black", "red")
) %>%
arrange(col)
walk2(x$cardinalities, x$col, ~ cli::cat_bullet(.x, bullet_col = .y))
if (sum(x$col == "red") > 0) {
cli::cli_alert_warning("Not all FK constraints satisfied, call `dm_examine_constraints()` for details.")
}
invisible(x)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.