1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
#' 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 at
#' \url{https://www.seanlahman.com/baseball-archive/statistics/}, 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
|
