scda coverage - 100.00%

Files
Source

#' Get Synthetic CDISC Dataset
#'
#' @param archive_name name of data collection. If `archive_name = "latest"` then the newest dataset gets returned.
#' @param dataset_name the lowercase name of the requested dataset (e.g. `"adsl"`).
#'
#' @return A `data.frame` containing synthetic data.
#'
#' @examples
#' \dontrun{
#' library(scda.2022)
#'
#' adsl <- synthetic_cdisc_dataset("latest", "adsl")
#' }
#'
#' @export
synthetic_cdisc_dataset <- function(archive_name, dataset_name) {
  avail <- ls_synthetic_cdisc_data()
  dt <- paste(archive_name, dataset_name, sep = "_")

  if (nrow(avail) == 0) { # nocov start
    stop("No synthetic CDISC data archive packages are installed.", call. = FALSE)
  } # nocov end

  if (identical(archive_name, "latest")) {
    dt <- paste(substring(avail$Name[avail$Latest], 1, 14)[1], dataset_name, sep = "_")
  }

  stopifnot(
    length(archive_name) == 1 & length(dataset_name) == 1,
    dt %in% avail$Name
  )

  i <- which(dt == avail$Name)

  sel <- as.list(avail[i, ])

  e <- new.env()
  cl <- call("data", sel$Name, envir = quote(e), package = sel$Package)
  eval(cl)

  structure(e[[dt]], data_from = c(sel$Package, sel$Name))
}

#' Get Synthetic CDISC Data
#'
#' @param name name of data collection to return. If `name = "latest"` then the newest datasets get returned.
#'
#' @return A named `list` containing synthetic datasets.
#'
#' @examples
#' \dontrun{
#' library(scda.2022)
#'
#' dfs <- synthetic_cdisc_data("rcd_2022_06_27")
#' names(dfs)
#'
#' latest_dfs <- synthetic_cdisc_data("latest")
#' names(latest_dfs)
#' }
#'
#' @export
synthetic_cdisc_data <- function(name) {
  avail <- ls_synthetic_cdisc_data()

  if (nrow(avail) == 0) { # nocov start
    stop("No synthetic CDISC data archive packages are installed.", call. = FALSE)
  } # nocov end

  if (identical(name, "latest")) {
    name <- substring(avail$Name[avail$Latest], 1, 14)[1]
  }

  stopifnot(
    length(name) == 1,
    name %in% avail$Name
  )

  i <- which(name == avail$Name)

  sel <- as.list(avail[i, ])

  e <- new.env()
  cl <- call("data", sel$Name, envir = quote(e), package = sel$Package)
  eval(cl)

  structure(e[[sel$Name]], data_from = c(sel$Package, sel$Name))
}

#' List Available Data
#'
#' @importFrom utils installed.packages data
#'
#' @examples
#' ls_synthetic_cdisc_data()
#'
#' @export
ls_synthetic_cdisc_data <- function() {
  all_pkgs <- as.vector(installed.packages()[, "Package"])
  pkgs <- unique(all_pkgs[grepl("^scda\\.[[:digit:]]{4}$", all_pkgs)])

  if (length(pkgs) == 0) { # nocov start
    data.frame(
      Name = character(0),
      Title = character(0),
      Package = character(0),
      stringsAsFactors = FALSE
    )
  } else { # nocov end
    all <- do.call(rbind, lapply(pkgs, function(pkgi) {
      dnms <- data(package = pkgi)$results[, 3:4]

      df <- if (length(dnms) == 2) { # nocov start
        data.frame(
          Item = dnms[1],
          Title = dnms[2],
          row.names = NULL,
          stringsAsFactors = FALSE
        )
      } else { # nocov end
        as.data.frame(dnms, stringsAsFactors = FALSE)
      }

      df$Package <- pkgi # nolint
      df
    }))

    names(all) <- c("Name", "Title", "Package")

    dates <- as.Date(substring(all$Name, 5, 14), format = "%Y_%m_%d")

    all$Latest <- FALSE # nolint
    all$Latest[dates == max(dates)] <- TRUE

    all
  }
}

.onAttach <- function(libname, pkgname) { # nolint
  scda_lookup <- paste0("scda.", seq(2020, 2030))
  is_scdax <- any(vapply(scda_lookup, function(x) length(find.package(x, quiet = TRUE)) > 0, logical(1)))
  packageStartupMessage(
    if (!is_scdax) { # nocov start
      paste0(
        "There are no scda.XXXX libraries installed, like scda.2022.",
        "\nPlease install an scda database to take full advantage of the scda package.",
        "\nVisit https://insightsengineering.github.io/scda.2022/ for details on scda.2022 and how it can be installed."
      )
    } # nocov end
  )
}

1		#' Get Synthetic CDISC Dataset
2		#'
3		#' @param archive_name name of data collection. If `archive_name = "latest"` then the newest dataset gets returned.
4		#' @param dataset_name the lowercase name of the requested dataset (e.g. `"adsl"`).
5		#'
6		#' @return A `data.frame` containing synthetic data.
7		#'
8		#' @examples
9		#' \dontrun{
10		#' library(scda.2022)
11		#'
12		#' adsl <- synthetic_cdisc_dataset("latest", "adsl")
13		#' }
14		#'
15		#' @export
16		synthetic_cdisc_dataset <- function(archive_name, dataset_name) {
17	2x	avail <- ls_synthetic_cdisc_data()
18	2x	dt <- paste(archive_name, dataset_name, sep = "_")
19
20		if (nrow(avail) == 0) { # nocov start
21		stop("No synthetic CDISC data archive packages are installed.", call. = FALSE)
22		} # nocov end
23
24	2x	if (identical(archive_name, "latest")) {
25	1x	dt <- paste(substring(avail$Name[avail$Latest], 1, 14)[1], dataset_name, sep = "_")
26		}
27
28	2x	stopifnot(
29	2x	length(archive_name) == 1 & length(dataset_name) == 1,
30	2x	dt %in% avail$Name
31		)
32
33	2x	i <- which(dt == avail$Name)
34
35	2x	sel <- as.list(avail[i, ])
36
37	2x	e <- new.env()
38	2x	cl <- call("data", sel$Name, envir = quote(e), package = sel$Package)
39	2x	eval(cl)
40
41	2x	structure(e[[dt]], data_from = c(sel$Package, sel$Name))
42		}
43
44		#' Get Synthetic CDISC Data
45		#'
46		#' @param name name of data collection to return. If `name = "latest"` then the newest datasets get returned.
47		#'
48		#' @return A named `list` containing synthetic datasets.
49		#'
50		#' @examples
51		#' \dontrun{
52		#' library(scda.2022)
53		#'
54		#' dfs <- synthetic_cdisc_data("rcd_2022_06_27")
55		#' names(dfs)
56		#'
57		#' latest_dfs <- synthetic_cdisc_data("latest")
58		#' names(latest_dfs)
59		#' }
60		#'
61		#' @export
62		synthetic_cdisc_data <- function(name) {
63	2x	avail <- ls_synthetic_cdisc_data()
64
65		if (nrow(avail) == 0) { # nocov start
66		stop("No synthetic CDISC data archive packages are installed.", call. = FALSE)
67		} # nocov end
68
69	2x	if (identical(name, "latest")) {
70	1x	name <- substring(avail$Name[avail$Latest], 1, 14)[1]
71		}
72
73	2x	stopifnot(
74	2x	length(name) == 1,
75	2x	name %in% avail$Name
76		)
77
78	2x	i <- which(name == avail$Name)
79
80	2x	sel <- as.list(avail[i, ])
81
82	2x	e <- new.env()
83	2x	cl <- call("data", sel$Name, envir = quote(e), package = sel$Package)
84	2x	eval(cl)
85
86	2x	structure(e[[sel$Name]], data_from = c(sel$Package, sel$Name))
87		}
88
89		#' List Available Data
90		#'
91		#' @importFrom utils installed.packages data
92		#'
93		#' @examples
94		#' ls_synthetic_cdisc_data()
95		#'
96		#' @export
97		ls_synthetic_cdisc_data <- function() {
98	5x	all_pkgs <- as.vector(installed.packages()[, "Package"])
99	5x	pkgs <- unique(all_pkgs[grepl("^scda\\.[[:digit:]]{4}$", all_pkgs)])
100
101		if (length(pkgs) == 0) { # nocov start
102		data.frame(
103		Name = character(0),
104		Title = character(0),
105		Package = character(0),
106		stringsAsFactors = FALSE
107		)
108		} else { # nocov end
109	5x	all <- do.call(rbind, lapply(pkgs, function(pkgi) {
110	5x	dnms <- data(package = pkgi)$results[, 3:4]
111
112	5x	df <- if (length(dnms) == 2) { # nocov start
113	5x	data.frame(
114	5x	Item = dnms[1],
115	5x	Title = dnms[2],
116	5x	row.names = NULL,
117	5x	stringsAsFactors = FALSE
118		)
119	5x	} else { # nocov end
120	5x	as.data.frame(dnms, stringsAsFactors = FALSE)
121		}
122
123	5x	df$Package <- pkgi # nolint
124	5x	df
125		}))
126
127	5x	names(all) <- c("Name", "Title", "Package")
128
129	5x	dates <- as.Date(substring(all$Name, 5, 14), format = "%Y_%m_%d")
130
131	5x	all$Latest <- FALSE # nolint
132	5x	all$Latest[dates == max(dates)] <- TRUE
133
134	5x	all
135		}
136		}

1		.onAttach <- function(libname, pkgname) { # nolint
2	2x	scda_lookup <- paste0("scda.", seq(2020, 2030))
3	2x	is_scdax <- any(vapply(scda_lookup, function(x) length(find.package(x, quiet = TRUE)) > 0, logical(1)))
4	2x	packageStartupMessage(
5	2x	if (!is_scdax) { # nocov start
6	2x	paste0(
7	2x	"There are no scda.XXXX libraries installed, like scda.2022.",
8	2x	"\nPlease install an scda database to take full advantage of the scda package.",
9	2x	"\nVisit https://insightsengineering.github.io/scda.2022/ for details on scda.2022 and how it can be installed."
10		)
11	2x	} # nocov end
12		)
13		}