knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
library(AnvilDataModels)
library(dplyr)
tables <- read_data_tables(params$tables)
model <- json_to_dm(params$model)
bucket_flag <- as.logical(params$check_bucket_paths)
return_value <- TRUE # returned to render function to indicate T/F passing checks

Data model version: r attr(model, "data_model_version")

Required tables

chk <- check_table_names(tables, model)
res <- tibble(a=c("Required tables in data model missing from input",
                  #"Optional tables in data model missing from input",
           "Extra tables not in data model"),
       b=c(paste(chk$missing_required_tables, collapse=", "),
           #paste(chk$missing_optional_tables, collapse=", "),
           paste(chk$extra_tables, collapse=", "))
       ) %>%
    filter(b != "")
if (nrow(res) > 0) {
    knitr::kable(res, col.names=NULL)
} else {
    cat("Table names match data model.")
}
if (length(chk$missing_required_tables) > 0) return_value <- FALSE

Required columns

chk <- check_column_names(tables, model)
res <- parse_column_name_check(chk)
if (nrow(res) > 0) {
    knitr::kable(res)
} else {
    cat("All column names match data model.")
}
if (length(unlist(lapply(chk, function(x) x$missing_required_columns))) > 0) return_value <- FALSE
chk <- check_missing_values(tables, model)
res <- parse_column_type_check(chk)
if (nrow(res) > 0) {
    return_value <- FALSE
    knitr::kable(res)
} else {
    cat("No missing values in required columns.")
}

Column types

chk <- check_column_types(tables, model)
res <- parse_column_type_check(chk)
if (nrow(res) > 0) {
    return_value <- FALSE
    knitr::kable(res)
} else {
    cat("All column types match data model.")
}
chk <- check_column_min_max(tables, model)
if (any(!sapply(chk, is.null))) {
    res <- parse_column_type_check(chk)
    if (nrow(res) > 0) {
        return_value <- FALSE
        knitr::kable(res)
    } else {
        cat("All column values are within specified min and max range.")
    }
}
chk <- check_unique(tables, model)
res <- parse_column_type_check(chk)
if (nrow(res) > 0) {
    return_value <- FALSE
    knitr::kable(res)
}
if (bucket_flag) {
    chk <- check_bucket_paths(tables, model)
    res <- parse_column_type_check(chk)
    if (nrow(res) > 0) {
        return_value <- FALSE
        knitr::kable(res)
    }
}

Primary keys

chk <- check_primary_keys(tables, model)
if (length(chk$missing_keys) == 0) {
    print(chk$found_keys)
} else {
    cat("Some primary keys missing:")
    ul <- unlist(chk$missing_keys)
    print(knitr::kable(tibble(Table=names(ul), Column=ul)))
    print(chk$found_keys)
    return_value <- FALSE
}
if (any(chk$found_keys$problem != "")) return_value <- FALSE
chk <- check_valid_entity_id(tables, model)
res <- parse_column_type_check(chk)
if (nrow(res) > 0) {
    return_value <- FALSE
    cat("AnVIL requires that each table has an entity_id named <table_name>_id. Entity ids may only contain alphanumeric characters, underscores, dashes, and periods.")
    knitr::kable(res)
}

Cross-table references

chk <- check_foreign_keys(tables, model)
if (length(chk$missing_keys) == 0) {
    print(chk$found_keys)
} else {
    cat("Some foreign keys missing:")
    ul <- unlist(chk$missing_keys)
    print(knitr::kable(tibble(Table=names(ul), Column=ul)))
    print(chk$found_keys)
    return_value <- FALSE
}
if (length(chk$set_key_problems) > 0) {
    ul <- unlist(chk$set_key_problems)
    print(knitr::kable(tibble(Child=names(ul), Parent=ul)))
    return_value <- FALSE
}
if (any(chk$found_keys$problem != "")) return_value <- FALSE


UW-GAC/AnvilDataModels documentation built on Nov. 3, 2024, 7:33 p.m.