diff --git a/R/get_sundered_data.R b/R/get_sundered_data.R index 57cfe9ff2..6b20072c0 100644 --- a/R/get_sundered_data.R +++ b/R/get_sundered_data.R @@ -434,20 +434,34 @@ get_sundered_data <- function( if (!is.null(type) && type == "pass") { - sundered_tbl_pass <- - tbl_check_join %>% - dplyr::filter(pb_is_good_ == 1) %>% - dplyr::select(-pb_is_good_) + if (uses_numeric_logical(input_tbl)) { + sundered_tbl_pass <- + tbl_check_join %>% + dplyr::filter(pb_is_good_ == 1) %>% + dplyr::select(-pb_is_good_) + } else { + sundered_tbl_pass <- + tbl_check_join %>% + dplyr::filter(pb_is_good_ == TRUE) %>% + dplyr::select(-pb_is_good_) + } return(sundered_tbl_pass) } if (!is.null(type) && type == "fail") { - sundered_tbl_fail <- - tbl_check_join %>% - dplyr::filter(pb_is_good_ == 0) %>% - dplyr::select(-pb_is_good_) + if (uses_numeric_logical(input_tbl)) { + sundered_tbl_fail <- + tbl_check_join %>% + dplyr::filter(pb_is_good_ == 0) %>% + dplyr::select(-pb_is_good_) + } else { + sundered_tbl_fail <- + tbl_check_join %>% + dplyr::filter(pb_is_good_ == FALSE) %>% + dplyr::select(-pb_is_good_) + } return(sundered_tbl_fail) } @@ -468,15 +482,27 @@ get_sundered_data <- function( if (is.null(type)) { - sundered_tbl_list <- - list( - pass = tbl_check_join %>% - dplyr::filter(pb_is_good_ == 1) %>% - dplyr::select(-pb_is_good_), - fail = tbl_check_join %>% - dplyr::filter(pb_is_good_ == 0) %>% - dplyr::select(-pb_is_good_) - ) + if (uses_numeric_logical(input_tbl)) { + sundered_tbl_list <- + list( + pass = tbl_check_join %>% + dplyr::filter(pb_is_good_ == 1) %>% + dplyr::select(-pb_is_good_), + fail = tbl_check_join %>% + dplyr::filter(pb_is_good_ == 0) %>% + dplyr::select(-pb_is_good_) + ) + } else { + sundered_tbl_list <- + list( + pass = tbl_check_join %>% + dplyr::filter(pb_is_good_ == TRUE) %>% + dplyr::select(-pb_is_good_), + fail = tbl_check_join %>% + dplyr::filter(pb_is_good_ == FALSE) %>% + dplyr::select(-pb_is_good_) + ) + } return(sundered_tbl_list) } diff --git a/R/interrogate.R b/R/interrogate.R index 3b88ca371..ed5e8ee66 100644 --- a/R/interrogate.R +++ b/R/interrogate.R @@ -1230,8 +1230,8 @@ tbl_vals_between <- function( right = {{ right }} ) - true <- if (is_tbl_mssql(table)) 1 else TRUE - false <- if (is_tbl_mssql(table)) 0 else FALSE + true <- if (uses_numeric_logical(table)) 1 else TRUE + false <- if (uses_numeric_logical(table)) 0 else FALSE na_pass_bool <- if (na_pass) true else false # @@ -1386,8 +1386,8 @@ interrogate_set <- function( # Ensure that the `column` provided is valid column_validity_checks_column(table = table, column = {{ column }}) - true <- if (is_tbl_mssql(table)) 1 else TRUE - false <- if (is_tbl_mssql(table)) 0 else FALSE + true <- if (uses_numeric_logical(table)) 1 else TRUE + false <- if (uses_numeric_logical(table)) 0 else FALSE na_pass_bool <- if (na_pass) true else false table %>% diff --git a/R/scan_data.R b/R/scan_data.R index 2d3490099..02c30f581 100644 --- a/R/scan_data.R +++ b/R/scan_data.R @@ -1315,8 +1315,8 @@ probe_interactions <- function(data) { ggforce::geom_autodensity() + ggplot2::geom_density2d() + ggforce::facet_matrix( - rows = ggplot2::vars(gt::everything()), layer.diag = 2, layer.upper = 3, - grid.y.diag = FALSE) + + rows = ggplot2::vars(dplyr::everything()), layer.diag = 2, + layer.upper = 3, grid.y.diag = FALSE, labeller = ggplot2::label_value) + ggplot2::theme_minimal() + ggplot2::theme( axis.text.x = ggplot2::element_text( diff --git a/R/utils.R b/R/utils.R index 21bf55a08..640261c39 100644 --- a/R/utils.R +++ b/R/utils.R @@ -84,10 +84,50 @@ is_tbl_mssql <- function(x) { return(FALSE) } + # detect by class + if (any(grepl("mssql|sqlserver", class(x), ignore.case = TRUE))) { + return(TRUE) + } + + # fallback to parsing source details tbl_src_details <- tolower(get_tbl_dbi_src_details(x)) grepl("sql server|sqlserver", tbl_src_details) } +is_tbl_duckdb <- function(x) { + + if (!is_tbl_dbi(x)) { + return(FALSE) + } + + if (any(grepl("duckdb", class(x), ignore.case = TRUE))) { + return(TRUE) + } + + tbl_src_details <- tolower(get_tbl_dbi_src_details(x)) + grepl("duckdb", tbl_src_details) +} + +is_tbl_sqlite <- function(x) { + + if (!is_tbl_dbi(x)) { + return(FALSE) + } + + if (any(grepl("sqlite", class(x), ignore.case = TRUE))) { + return(TRUE) + } + + tbl_src_details <- tolower(get_tbl_dbi_src_details(x)) + grepl("sqlite", tbl_src_details) +} + +# Check if table type requires numeric logical values (1/0) instead of +# logicals +uses_numeric_logical <- function(x) { + is_tbl_mssql(x) || is_tbl_duckdb(x) || is_tbl_sqlite(x) +} + # nocov end # Generate a label for the `agent` or `informant` object @@ -766,7 +806,16 @@ get_tbl_dbi_src_info <- function(tbl) { get_tbl_dbi_src_details <- function(tbl) { tbl_src_info <- get_tbl_dbi_src_info(tbl) - tbl_src_info[grepl("^src:", tbl_src_info)] %>% gsub("src:\\s*", "", .) + # filter lines that start with "src:" and remove leading/trailing whitespace + src_lines <- tbl_src_info[grepl("^\\s*src:", tbl_src_info)] + if (length(src_lines) > 0) { + result <- gsub("src:\\s*", "", src_lines[1]) + result <- trimws(result) + return(result) + } + + # if no "src:" line found + "" } get_r_column_names_types <- function(tbl) { @@ -876,26 +925,45 @@ get_tbl_information_dbi <- function(tbl) { tbl_src_details <- tolower(get_tbl_dbi_src_details(tbl)) - if (grepl("sql server|sqlserver", tbl_src_details)) { + if (grepl("sql server|sqlserver", tbl_src_details) || + any(grepl("mssql|sqlserver", class(tbl), ignore.case = TRUE))) { # nocov start tbl_src <- "mssql" # nocov end - } else if (grepl("duckdb", tbl_src_details)) { + } else if (grepl("duckdb", tbl_src_details) || + any(grepl("duckdb", class(tbl), ignore.case = TRUE))) { # nocov start tbl_src <- "duckdb" # nocov end - } else if (grepl("bq_|bigquery", tbl_src_details)) { + } else if (grepl("bq_|bigquery", tbl_src_details) || + any(grepl("bigquery", class(tbl), ignore.case = TRUE))) { # nocov start tbl_src <- "bigquery" # nocov end + } else if (any(grepl("sqlite", class(tbl), ignore.case = TRUE))) { + + tbl_src <- "sqlite" + } else { - tbl_src <- gsub("^([a-z]*).*", "\\1", tbl_src_details) + # try to extract from src details, fallback to class inspection + if (nchar(tbl_src_details) > 0) { + tbl_src <- gsub("^([a-z]*).*", "\\1", tbl_src_details) + } else { + class_str <- paste(class(tbl), collapse = " ") + if (grepl("postgres", class_str, ignore.case = TRUE)) { + tbl_src <- "postgres" + } else if (grepl("mysql", class_str, ignore.case = TRUE)) { + tbl_src <- "mysql" + } else { + tbl_src <- "unknown" + } + } } db_tbl_name <- as.character(dbplyr::remote_name(tbl))