File: data.R

package info (click to toggle)
r-cran-usethis 3.1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,228 kB
  • sloc: sh: 26; makefile: 17; cpp: 6; ansic: 3
file content (154 lines) | stat: -rw-r--r-- 4,608 bytes parent folder | download
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
#' Create package data
#'
#' `use_data()` makes it easy to save package data in the correct format. I
#' recommend you save scripts that generate package data in `data-raw`: use
#' `use_data_raw()` to set it up. You also need to document exported datasets.
#'
#' @param ... Unquoted names of existing objects to save.
#' @param internal If `FALSE`, saves each object in its own `.rda`
#'   file in the `data/` directory. These data files bypass the usual
#'   export mechanism and are available whenever the package is loaded
#'   (or via [data()] if `LazyData` is not true).
#'
#'   If `TRUE`, stores all objects in a single `R/sysdata.rda` file.
#'   Objects in this file follow the usual export rules. Note that this means
#'   they will be exported if you are using the common `exportPattern()`
#'   rule which exports all objects except for those that start with `.`.
#' @param overwrite By default, `use_data()` will not overwrite existing
#'   files. If you really want to do so, set this to `TRUE`.
#' @param compress Choose the type of compression used by [save()].
#'   Should be one of "gzip", "bzip2", or "xz".
#' @param version The serialization format version to use. The default, 3, can
#'   only be read by R versions 3.5.0 and higher. For R 1.4.0 to 3.5.3, use
#'   version 2.
#' @inheritParams base::save
#'
#' @seealso The [data chapter](https://r-pkgs.org/data.html) of [R
#'   Packages](https://r-pkgs.org).
#' @export
#' @examples
#' \dontrun{
#' x <- 1:10
#' y <- 1:100
#'
#' use_data(x, y) # For external use
#' use_data(x, y, internal = TRUE) # For internal use
#' }
use_data <- function(...,
                     internal = FALSE,
                     overwrite = FALSE,
                     compress = "bzip2",
                     version = 3,
                     ascii = FALSE) {
  check_is_package("use_data()")

  objs <- get_objs_from_dots(dots(...))

  original_minimum_r_version <- pkg_minimum_r_version()
  serialization_minimum_r_version <- if (version < 3) "2.10" else "3.5"
  if (is.na(original_minimum_r_version) ||
      original_minimum_r_version < serialization_minimum_r_version) {
        use_dependency("R", "depends", serialization_minimum_r_version)
  }

  if (internal) {
    use_directory("R")
    paths <- path("R", "sysdata.rda")
    objs <- list(objs)
  } else {
    use_directory("data")
    paths <- path("data", objs, ext = "rda")
    desc <- proj_desc()

    if (!desc$has_fields("LazyData")) {
      ui_bullets(c(
        "v" = "Setting {.field LazyData} to {.val true} in {.path DESCRIPTION}."))
      desc$set(LazyData = "true")
      desc$write()
    }
  }
  check_files_absent(proj_path(paths), overwrite = overwrite)

  ui_bullets(c(
    "v" = "Saving {.val {unlist(objs)}} to {.val {paths}}."))
  if (!internal) {
    ui_bullets(c(
      "_" = "Document your data (see {.url https://r-pkgs.org/data.html})."
    ))
  }

  envir <- parent.frame()
  mapply(
    save,
    list = objs,
    file = proj_path(paths),
    MoreArgs = list(envir = envir, compress = compress, version = version, ascii = ascii)
  )

  invisible()
}

get_objs_from_dots <- function(.dots) {
  if (length(.dots) == 0L) {
    ui_abort("Nothing to save.")
  }

  is_name <- vapply(.dots, is.symbol, logical(1))
  if (!all(is_name)) {
    ui_abort("Can only save existing named objects.")
  }

  objs <- vapply(.dots, as.character, character(1))
  duplicated_objs <- which(stats::setNames(duplicated(objs), objs))
  if (length(duplicated_objs) > 0L) {
    objs <- unique(objs)
    ui_bullets(c(
      "!" = "Saving duplicates only once: {.val {names(duplicated_objs)}}."
    ))
  }
  objs
}

check_files_absent <- function(paths, overwrite) {
  if (overwrite) {
    return()
  }

  ok <- !file_exists(paths)

  if (all(ok)) {
    return()
  }

  ui_abort(c(
    "{.path {pth(paths[!ok])}} already exist.",
    "Use {.code overwrite = TRUE} to overwrite."
  ))
}

#' @param name Name of the dataset to be prepared for inclusion in the package.
#' @inheritParams use_template
#' @rdname use_data
#' @export
#' @examples
#' \dontrun{
#' use_data_raw("daisy")
#' }
use_data_raw <- function(name = "DATASET", open = rlang::is_interactive()) {
  check_name(name)
  r_path <- path("data-raw", asciify(name), ext = "R")
  use_directory("data-raw", ignore = TRUE)

  use_template(
    "packagename-data-prep.R",
    save_as = r_path,
    data = list(name = name),
    ignore = FALSE,
    open = open
  )

  ui_bullets(c(
    "_" = "Finish writing the data preparation script in {.path {pth(r_path)}}.",
    "_" = "Use {.fun usethis::use_data} to add prepared data to package."
  ))
}