From df4e860a5b97d379769cb7a0941dcaebeb622259 Mon Sep 17 00:00:00 2001 From: lilyclements Date: Mon, 2 Dec 2024 17:35:04 +0000 Subject: [PATCH 1/3] adding frac* to rd --- NAMESPACE | 3 +++ R/group_functions.R | 6 ++++++ man/frac10.Rd | 9 +++++++++ 3 files changed, 18 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ed330ea..490343f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,9 @@ export(drop_unused_levels) export(duplicated_cases) export(duplicated_count_index) export(frac10) +export(frac100) +export(frac20) +export(frac_den) export(getExample) export(getRowHeadersWithText) export(get_column_attributes) diff --git a/R/group_functions.R b/R/group_functions.R index 1f4a2da..d1cd631 100644 --- a/R/group_functions.R +++ b/R/group_functions.R @@ -709,8 +709,14 @@ check_github_repo <- function(owner = NULL, repo = NULL, url = NULL) { #' #' @export frac10 <- function(x) { paste0(round(x * 10), "/", 10) } +#' @rdname frac10 +#' @export frac20 <- function(x) { paste0(round(x * 20), "/", 20) } +#' @rdname frac10 +#' @export frac100 <- function(x) { paste0(round(x * 100), "/", 100) } +#' @rdname frac10 +#' @export frac_den <- function(x, den) { paste0(round(x * den), "/", den) } #' Monitor Memory Usage diff --git a/man/frac10.Rd b/man/frac10.Rd index 8b41341..c56d306 100644 --- a/man/frac10.Rd +++ b/man/frac10.Rd @@ -2,9 +2,18 @@ % Please edit documentation in R/group_functions.R \name{frac10} \alias{frac10} +\alias{frac20} +\alias{frac100} +\alias{frac_den} \title{Convert Decimal to Fraction} \usage{ frac10(x) + +frac20(x) + +frac100(x) + +frac_den(x, den) } \arguments{ \item{x}{A numeric value representing the decimal to convert.} From 2afcdb314c36cd5461959f2bc40b99242dafdc15 Mon Sep 17 00:00:00 2001 From: lilyclements Date: Mon, 2 Dec 2024 17:44:38 +0000 Subject: [PATCH 2/3] adding pkg names --- DESCRIPTION | 1 + R/global.R | 2 +- R/group_functions.R | 7 ++++--- R/package_check.R | 8 ++++---- man/getRowHeadersWithText.Rd | 2 ++ 5 files changed, 12 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6c68b33..ef23257 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,6 +19,7 @@ Imports: getPass, ggplot2, ggrepel, + gh, grDevices, gt, htmlwidgets, diff --git a/R/global.R b/R/global.R index 596c90b..6c4bdf1 100644 --- a/R/global.R +++ b/R/global.R @@ -1,2 +1,2 @@ utils::globalVariables(c("av_packs","fq","labels_label","data_unstacked",".","level.out", - "index.search", "<<-")) \ No newline at end of file + "index.search", "<<-", "av_packs")) \ No newline at end of file diff --git a/R/group_functions.R b/R/group_functions.R index d1cd631..3bcbe73 100644 --- a/R/group_functions.R +++ b/R/group_functions.R @@ -163,7 +163,7 @@ view_graph_object <- function(graph_object){ }else{ print(graph_object) } - dev.off() #todo. use graphics.off() which one is better? + grDevices::dev.off() #todo. use graphics.off() which one is better? #todo. should we use respective package "convenience" functions to save the objects as image files depending on the class names? @@ -312,7 +312,7 @@ check_graph <- function(graph_object){ if (is.null(out)) { out <- tryCatch({ message("Recording plot") - recordPlot() + grDevices::recordPlot() }, error = function(cond) { message("Graph object does not exist:") @@ -474,6 +474,7 @@ get_vignette <- function (package = NULL, lib.loc = NULL, all = TRUE) #' @param searchText The text to search for. #' @param ignore_case Logical indicating whether to ignore case. Defaults to TRUE. #' @param use_regex Logical indicating whether to use regular expressions. Defaults to FALSE. +#' @param match_entire_cell Logical indicating whether to match the entire cell. #' @return A character vector of row headers where the search text is found. #' @examples #' \dontrun{ @@ -733,7 +734,7 @@ frac_den <- function(x, den) { paste0(round(x * den), "/", den) } #' @export monitor_memory <- function() { if (.Platform$OS.type == "windows") { - mem_used <- memory.size() + mem_used <- utils::memory.size() } else { mem_used <- sum(gc()[, "used"]) / 1024 } diff --git a/R/package_check.R b/R/package_check.R index f392b8a..2239f97 100644 --- a/R/package_check.R +++ b/R/package_check.R @@ -45,11 +45,11 @@ package_check <- function(package) { #CHECK the Package is a CRAN package if (package %in% av_packs$Package){ #PACKAGE IS INSTALLED - if (package %in% rownames(installed.packages())){ + if (package %in% rownames(utils::installed.packages())){ out[[1]] <- "1" - v_machine <- as.character(packageVersion(package)) + v_machine <- as.character(utils::packageVersion(package)) v_web <- as.character(av_packs[av_packs$Package == package, "Version"]) - out[[2]] <- compareVersion(v_machine, v_web) + out[[2]] <- utils::compareVersion(v_machine, v_web) out[[3]] <- v_machine out[[4]] <- v_web } @@ -57,7 +57,7 @@ package_check <- function(package) { } else{ #PACKAGE IS INSTALLED BUT NOT IN THE CRAN REPO - if (package %in% rownames(installed.packages())) out[[1]] <- "3" + if (package %in% rownames(utils::installed.packages())) out[[1]] <- "3" #PACKAGE IS NOT INSTALLED AND NOT IN THE CRAN REPO else out[[1]] <- "4" } diff --git a/man/getRowHeadersWithText.Rd b/man/getRowHeadersWithText.Rd index f016acd..b661f2a 100644 --- a/man/getRowHeadersWithText.Rd +++ b/man/getRowHeadersWithText.Rd @@ -23,6 +23,8 @@ getRowHeadersWithText( \item{ignore_case}{Logical indicating whether to ignore case. Defaults to TRUE.} \item{use_regex}{Logical indicating whether to use regular expressions. Defaults to FALSE.} + +\item{match_entire_cell}{Logical indicating whether to match the entire cell.} } \value{ A character vector of row headers where the search text is found. From 5444cbd8ef4d27789d5db627e26e3b9a441ea238 Mon Sep 17 00:00:00 2001 From: lilyclements Date: Mon, 2 Dec 2024 17:49:37 +0000 Subject: [PATCH 3/3] adding unexported functions --- R/group_functions.R | 6 ++--- R/unexported.R | 64 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 67 insertions(+), 3 deletions(-) create mode 100644 R/unexported.R diff --git a/R/group_functions.R b/R/group_functions.R index 3bcbe73..d2e76e6 100644 --- a/R/group_functions.R +++ b/R/group_functions.R @@ -559,7 +559,7 @@ getExample <- function (topic, package = NULL, lib.loc = NULL, character.only = topic <- deparse(topic)[1L] } pkgpaths <- find.package(package, lib.loc, verbose = verbose) - file <- utils:::index.search(topic, pkgpaths, firstOnly = TRUE) + file <- index.search(topic, pkgpaths, firstOnly = TRUE) if (!length(file)) { warning(gettextf("no help found for %s", sQuote(topic)), domain = NA) @@ -571,7 +571,7 @@ getExample <- function (topic, package = NULL, lib.loc = NULL, character.only = pkgname <- basename(packagePath) lib <- dirname(packagePath) tf <- tempfile("Rex") - tools::Rd2ex(utils:::.getHelpFile(file), tf, commentDontrun = !run.dontrun, + tools::Rd2ex(getHelpFile(file), tf, commentDontrun = !run.dontrun, commentDonttest = !run.donttest) if (!file.exists(tf)) { if (give.lines) @@ -667,7 +667,7 @@ check_github_repo <- function(owner = NULL, repo = NULL, url = NULL) { repo <- basename(url) } if (requireNamespace(repo, quietly = TRUE)) { - local_sha <- packageDescription(repo)$GithubSHA1 + local_sha <- utils::packageDescription(repo)$GithubSHA1 if (!is.null(local_sha)) { latest_commit <- tryCatch({ response <- gh::gh("/repos/:owner/:repo/commits", owner = owner, repo = repo, .limit = 1) diff --git a/R/unexported.R b/R/unexported.R new file mode 100644 index 0000000..3c344aa --- /dev/null +++ b/R/unexported.R @@ -0,0 +1,64 @@ + +index.search <- function (topic, paths, firstOnly = FALSE) { + res <- character() + for (p in paths) { + if (file.exists(f <- file.path(p, "help", "aliases.rds"))) + al <- readRDS(f) + else if (file.exists(f <- file.path(p, "help", "AnIndex"))) { + foo <- scan(f, what = list(a = "", b = ""), sep = "\t", + quote = "", na.strings = "", quiet = TRUE) + al <- structure(foo$b, names = foo$a) + } + else next + f <- al[topic] + if (is.na(f)) + next + res <- c(res, file.path(p, "help", f)) + if (firstOnly) + break + } + res +} + +getHelpFile <- function (file) +{ + path <- dirname(file) + dirpath <- dirname(path) + if (!file.exists(dirpath)) + stop(gettextf("invalid %s argument", sQuote("file")), + domain = NA) + pkgname <- basename(dirpath) + RdDB <- file.path(path, pkgname) + if (!file.exists(paste0(RdDB, ".rdx"))) + stop(gettextf("package %s exists but was not installed under R >= 2.10.0 so help cannot be accessed", + sQuote(pkgname)), domain = NA) + fetchRdDB(RdDB, basename(file)) +} + +fetchRdDB <- function (filebase, key = NULL) +{ + fun <- function(db) { + vals <- db$vals + vars <- db$vars + datafile <- db$datafile + compressed <- db$compressed + envhook <- db$envhook + fetch <- function(key) lazyLoadDBfetch(vals[key][[1L]], + datafile, compressed, envhook) + if (length(key)) { + if (key %notin% vars) + stop(gettextf("No help on %s found in RdDB %s", + sQuote(key), sQuote(filebase)), domain = NA) + fetch(key) + } + else { + res <- lapply(vars, fetch) + names(res) <- vars + res + } + } + res <- lazyLoadDBexec(filebase, fun) + if (length(key)) + res + else invisible(res) +} \ No newline at end of file