|
| 1 | +#' Insert R data frame into SQL database |
| 2 | +#' |
| 3 | +#' First, subset to matching columns. Then, make sure the local and SQL column |
| 4 | +#' classes match, coercing local to SQL as necessary (or throwing an error). |
| 5 | +#' Then, build an SQL string for the insert statement. Finally, insert into the |
| 6 | +#' database. |
| 7 | +#' |
| 8 | +#' @param values `data.frame` of values to write to SQL database |
| 9 | +#' @param table Name of target SQL table, as character |
| 10 | +#' @param coerce_col_class logical, whether or not to coerce local data columns |
| 11 | +#' to SQL classes. Default = `TRUE.` |
| 12 | +#' @param drop logical. If `TRUE` (default), drop columns not found in SQL table. |
| 13 | +#' @inheritParams db.query |
| 14 | +#' @inherit db.query return |
| 15 | +#' @export |
| 16 | +#' @examples |
| 17 | +#' irisdb <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") |
| 18 | +#' dplyr::copy_to(irisdb, iris[1,], name = "iris", overwrite = TRUE) |
| 19 | +#' insert_table(iris[-1,], "iris", irisdb$con) |
| 20 | +#' dplyr::tbl(irisdb, "iris") |
| 21 | +insert_table <- function(values, table, con, coerce_col_class = TRUE, drop = TRUE) { |
| 22 | + values_fixed <- match_dbcols(values, table, con, coerce_col_class, drop = TRUE) |
| 23 | + insert_query <- build_insert_query(values_fixed, table, .con = con) |
| 24 | + db.query(insert_query, con) |
| 25 | +} |
| 26 | + |
| 27 | +#' Match column names and classes between local and SQL table |
| 28 | +#' |
| 29 | +#' @inheritParams insert_table |
| 30 | +#' @return `values` `data.frame` with column names and classes matched to SQL |
| 31 | +#' @export |
| 32 | +match_dbcols <- function(values, table, con, coerce_col_class = TRUE, drop = TRUE) { |
| 33 | + use_cols <- match_colnames(values, table, con) |
| 34 | + if (length(use_cols) < 1) { |
| 35 | + PEcAn.logger::logger.severe( |
| 36 | + "No columns match between input and target table." |
| 37 | + ) |
| 38 | + } |
| 39 | + PEcAn.logger::logger.debug( |
| 40 | + "Matched the following cols: ", |
| 41 | + paste(use_cols, collapse = ", ") |
| 42 | + ) |
| 43 | + values_sub <- values[, use_cols] |
| 44 | + # Load one row to get column types |
| 45 | + sql_row <- dplyr::tbl(con, table) %>% head(1) %>% dplyr::collect() |
| 46 | + sql_types <- purrr::map(sql_row, class) %>% |
| 47 | + purrr::map_chr(1) %>% |
| 48 | + .[use_cols] |
| 49 | + values_types <- purrr::map(values_sub, class) %>% purrr::map_chr(1) |
| 50 | + type_mismatch <- sql_types != values_types |
| 51 | + if (sum(type_mismatch) > 0) { |
| 52 | + mismatch_string <- sprintf( |
| 53 | + "%s: local is %s, SQL is %s", |
| 54 | + names(values_types), |
| 55 | + values_types, |
| 56 | + sql_types |
| 57 | + )[type_mismatch] |
| 58 | + PEcAn.logger::logger.info( |
| 59 | + "Found type mismatches in the following columns: ", |
| 60 | + paste0(mismatch_string, collapse = "; ") |
| 61 | + ) |
| 62 | + if (!coerce_col_class) { |
| 63 | + PEcAn.logger::logger.severe( |
| 64 | + "Type mismatch detected, and `coerce_col_class` is `FALSE`. ", |
| 65 | + "Fix column class mismatches manually." |
| 66 | + ) |
| 67 | + } else { |
| 68 | + PEcAn.logger::logger.info( |
| 69 | + "Coercing local column types to match SQL." |
| 70 | + ) |
| 71 | + # Coerce values data frame to these types |
| 72 | + values_fixed <- purrr::map2_dfc(values_sub, sql_types, as) |
| 73 | + } |
| 74 | + } else { |
| 75 | + values_fixed <- values_sub |
| 76 | + } |
| 77 | + if (drop) { |
| 78 | + values_fixed |
| 79 | + } else { |
| 80 | + drop_cols <- colnames(values)[!colnames(values) %in% use_cols] |
| 81 | + dplyr::bind_cols(values_fixed, values[, drop_cols]) |
| 82 | + } |
| 83 | +} |
| 84 | + |
| 85 | +#' Match names of local data frame to SQL table |
| 86 | +#' |
| 87 | +#' @inheritParams insert_table |
| 88 | +match_colnames <- function(values, table, con) { |
| 89 | + tbl_db <- dplyr::tbl(con, table) |
| 90 | + table_cols <- dplyr::tbl_vars(tbl_db) |
| 91 | + values_cols <- colnames(values) |
| 92 | + intersect(values_cols, table_cols) |
| 93 | +} |
| 94 | + |
| 95 | +#' Build query to insert R data frame into SQL table |
| 96 | +#' |
| 97 | +#' @inheritParams insert_table |
| 98 | +#' @inheritParams glue::glue_sql |
| 99 | +build_insert_query <- function(values, table, .con) { |
| 100 | + value_list <- purrr::map(seq_len(nrow(values)), ~as.list(values[.x, ])) |
| 101 | + |
| 102 | + insert_list <- value_list %>% |
| 103 | + purrr::map(unname) %>% |
| 104 | + purrr::map(dbplyr::escape) %>% |
| 105 | + purrr::map(dbplyr::sql_vector) |
| 106 | + |
| 107 | + glue::glue_sql( |
| 108 | + "INSERT INTO {`table`} ({`colnames(values)`*}) ", |
| 109 | + "VALUES {insert_list*}", |
| 110 | + .con = .con |
| 111 | + ) |
| 112 | +} |
0 commit comments