Nothing
#' Cache and retrieve an `src_sqlite` of the Lahman baseball database.
#'
#' This creates an interesting database using data from the Lahman baseball
#' data source, provided by [Sean Lahman](http://seanlahman.com), and
#' made easily available in R through the \pkg{Lahman} package by
#' Michael Friendly, Dennis Murphy and Martin Monkman. See the documentation
#' for that package for documentation of the individual tables.
#'
#' @param ... Other arguments passed to `src` on first
#' load. For MySQL and PostgreSQL, the defaults assume you have a local
#' server with `lahman` database already created.
#' For `lahman_srcs()`, character vector of names giving srcs to generate.
#' @param quiet if `TRUE`, suppress messages about databases failing to
#' connect.
#' @param type src type.
#' @keywords internal
#' @examples
#' # Connect to a local sqlite database, if already created
#' \donttest{
#' library(dplyr)
#'
#' if (has_lahman("sqlite")) {
#' lahman_sqlite()
#' batting <- tbl(lahman_sqlite(), "Batting")
#' batting
#' }
#'
#' # Connect to a local postgres database with lahman database, if available
#' if (has_lahman("postgres")) {
#' lahman_postgres()
#' batting <- tbl(lahman_postgres(), "Batting")
#' }
#' }
#' @name lahman
NULL
# nocov start
#' @export
#' @rdname lahman
lahman_sqlite <- function(path = NULL) {
path <- db_location(path, "lahman.sqlite")
con <- DBI::dbConnect(RSQLite::SQLite(), dbname = path)
copy_lahman(con)
}
#' @export
#' @rdname lahman
lahman_postgres <- function(dbname = "lahman", host = "localhost", ...) {
con <- DBI::dbConnect(RPostgres::Postgres(), dbname = dbname, host = host, ...)
copy_lahman(con)
}
#' @export
#' @rdname lahman
lahman_mysql <- function(dbname = "lahman", ...) {
con <- DBI::dbConnect(RMariaDB::MariaDB(), dbname = dbname, ...)
copy_lahman(con)
}
#' @rdname lahman
#' @export
copy_lahman <- function(con, ...) {
# Create missing tables
tables <- setdiff(lahman_tables(), DBI::dbListTables(con))
for (table in tables) {
df <- getExportedValue("Lahman", table)
message("Creating table: ", table)
ids <- as.list(names(df)[grepl("ID$", names(df))])
copy_to(con, df, table, indexes = ids, temporary = FALSE)
}
invisible(con)
}
# Get list of all non-label data frames in package
lahman_tables <- function() {
tables <- utils::data(package = "Lahman")$results[, 3]
tables[!grepl("Labels", tables)]
}
#' @rdname lahman
#' @export
has_lahman <- function(type, ...) {
if (!requireNamespace("Lahman", quietly = TRUE)) return(FALSE)
succeeds(lahman(type, ...), quiet = FALSE)
}
#' @rdname lahman
#' @export
lahman_srcs <- function(..., quiet = NULL) {
load_srcs(lahman, c(...), quiet = quiet)
}
lahman <- function(type, ...) {
f <- match.fun(paste0("lahman_", type))
f(...)
}
# nocov end
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.