update

DESCRIPTION

@@ -1,19 +1,17 @@
 Package: yulab.utils
 Title: Supporting Functions for Packages Maintained by 'YuLab-SMU'
-Version: 0.1.6.002
+Version: 0.1.6.003
 Authors@R: c(person("Guangchuang", "Yu", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6485-8781")))
 Description: Miscellaneous functions commonly used by 'YuLab-SMU'.
 Imports:
   cli,
   digest,
   fs,
-  httr2,
   rlang,
-  stats,
   tools,
   utils
 Suggests:
-  httr,
+  httr2,
   jsonlite,
   openssl,
   rappdirs

NAMESPACE

@@ -35,6 +35,7 @@ export(set_PCRE)
 export(set_TRE)
 export(set_regexpr_style)
 export(show_in_excel)
+export(str_detect)
 export(str_ends)
 export(str_extract)
 export(str_starts)
@@ -47,13 +48,9 @@ export(yulab_msg)
 importFrom(cli,cli_h2)
 importFrom(digest,digest)
 importFrom(fs,path_join)
-importFrom(httr2,req_perform)
-importFrom(httr2,req_progress)
-importFrom(httr2,request)
 importFrom(rlang,as_name)
 importFrom(rlang,check_installed)
 importFrom(rlang,enquo)
-importFrom(stats,setNames)
 importFrom(tools,package_dependencies)
 importFrom(utils,combn)
 importFrom(utils,download.file)

NEWS.md

@@ -1,6 +1,6 @@
-# yulab.utils 0.1.6.002
+# yulab.utils 0.1.6.003
 
-+ `c2()` to combine two vectors (20024-08-17, Sat)
++ export `str_detect()` (20024-08-19, Mon)
 + `user_dir()` to setup user data dir (20024-08-17, Sat)
 + `which_os()` to return the system name
 + `has_bin()` to check whether a command is exist in the system 

R/download.R

@@ -1,9 +1,11 @@
-#' @importFrom httr2 request
-#' @importFrom httr2 req_progress
-#' @importFrom httr2 req_perform
 mydownload <- function(url, destfile) {
-    req <- request(url) |> 
-        req_progress()
-
-    req |> req_perform(path = destfile)
+    if (is.installed('httr2')) {    
+        req <- httr2::request(url) |> 
+            httr2::req_progress()
+
+        req |> httr2::req_perform(path = destfile)
+    } else {
+        download.file(url = url, destfile = destfile)
+    }
 }
+

R/str-utils.R

@@ -6,41 +6,21 @@
 ##' @param width the maximum number of characters before wrapping to a new line
 ##' @return update strings with new line character inserted
 ##' @export
-##' @author Guangchuang Yu and Erqiang Hu
+##' @author Guangchuang Yu
 str_wrap <- function(string, width = getOption("width")) {
     ##
-    ## actually, there is a base::strwrap() function available
+    ## speed comparison
+    ##   str_wrap() > stringr::str_wrap() > paste0(base::strwrap(), collapse = "\n")
     ##
-
-    # x <- gregexpr(' ', string)
-    # vapply(seq_along(x),
-    #        FUN = function(i) {
-    #            y <- x[[i]]
-    #            n <- nchar(string[i])
-    #            len <- (c(y,n) - c(0, y)) ## length + 1
-    #            idx <- len > width
-    #            j <- which(!idx)
-    #            if (length(j) && max(j) == length(len)) {
-    #                j <- j[-length(j)]
-    #            }
-    #            if (length(j)) {
-    #                idx[j] <- len[j] + len[j+1] > width
-    #            }
-    #            idx <- idx[-length(idx)] ## length - 1
-    #            start <- c(1, y[idx] + 1)
-    #            end <- c(y[idx] - 1, n)
-    #            words <- substring(string[i], start, end)
-    #            paste0(words, collapse="\n")
-    #        },
-    #        FUN.VALUE = character(1)
-    # )
+
     result <- vapply(string,
            FUN = function(st) {
                words <- list()
                i <- 1
                while(nchar(st) > width) {
-                   if (length(grep(" ", st)) == 0) break
-                   y <- gregexpr(' ', st)[[1]]                  
+                   if (length(grep(pattern = " ", x = st, perl = use_perl())) == 0) break
+                   y <- gregexpr(pattern = ' ', text = st, perl = use_perl())
+                   y <- y[[1]]                  
                    n <- nchar(st)
                    y <- c(y,n)
                    idx <- which(y < width)
@@ -61,6 +41,7 @@ str_wrap <- function(string, width = getOption("width")) {
     result
 }
 
+
 ##' Detect the presence or absence of a pattern at the beginning or end of a string or string vector.
 ##'
 ##' 
@@ -84,12 +65,22 @@ str_ends <- function(string, pattern, negate=FALSE) {
     str_detect(string, pattern, negate)
 }
 
-##' @importFrom stats setNames
-str_detect <- function(string, pattern, negate) {
-    res <- setNames(
-        vapply(string, grepl, pattern=pattern, 
-                FUN.VALUE=logical(1)),
-        NULL)
+
+##' Detect the presentce/absence of a match
+##' 
+##' 
+##' @title str_detect
+##' @rdname str-detect
+##' @param string input string
+##' @param pattern pattern to look for
+##' @param negate if TRUE, inverts the resulting boolen vector
+##' @return logical vector
+##' @export
+##' @author Guangchuang Yu
+str_detect <- function(string, pattern, negate = FALSE) {
+    ## faster than stringr::str_detect
+
+    res <- grepl(pattern = pattern, x = string, perl = use_perl())
     if (negate) res <- !res
     return(res)            
 }
@@ -105,7 +96,7 @@ str_detect <- function(string, pattern, negate) {
 ##' @export
 ##' @author Guangchuang Yu
 str_extract <- function(string, pattern) {
-    i <- regexpr(pattern, string)
+    i <- regexpr(pattern = pattern, text = string, perl = use_perl())
     j <- attr(i, 'match.length')
     res <- substring(string, i, i+j-1)
     res[res == ""] <- NA