From 81cb0e6985494d5eaa066991d89fec05ade9ca25 Mon Sep 17 00:00:00 2001 From: Kevin Cazelles Date: Fri, 21 Jun 2019 15:55:38 -0400 Subject: [PATCH] remove stApply() :fire: --- NAMESPACE | 1 - R/applyString.R | 19 +++++---- R/signifSymbols.R | 2 +- R/stApply.R | 65 ------------------------------- docs/News.html | 2 +- docs/articles/overview.html | 51 ++++++++++++------------ docs/reference/applyString.html | 6 +-- docs/reference/index.html | 6 --- docs/reference/signifSymbols.html | 16 +++++++- man/applyString.Rd | 6 +-- man/signifSymbols.Rd | 2 +- man/stApply.Rd | 35 ----------------- tests/testthat/test-applyString.R | 8 ++-- vignettes/overview.Rmd | 15 ++++--- 14 files changed, 73 insertions(+), 161 deletions(-) delete mode 100644 R/stApply.R delete mode 100644 man/stApply.Rd diff --git a/NAMESPACE b/NAMESPACE index df1ce5f..6667a3f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,7 +30,6 @@ export(scaleWithin) export(setColClass) export(signifSymbols) export(squaretize) -export(stApply) export(substrBib) export(whichIs) export(wordCount) diff --git a/R/applyString.R b/R/applyString.R index 3adb7e7..df2f6da 100644 --- a/R/applyString.R +++ b/R/applyString.R @@ -6,10 +6,10 @@ #' Kevin Cazelles #' #' @param x a character vector, or a vector to be coerced to a character vector. -#' @param FUN the function to be applied, see [base::lapply]. +#' @param FUN the function to be applied, see [base::lapply()]. #' @param pos a vector indicating the elements position. -#' @param pattern a see [base::gregexpr]. -#' @param ... argument to be passed to `gregexpr`. +#' @param pattern a pattern see [base::gregexpr()]. +#' @param ... argument to be passed to [base::gregexpr()]. #' #' @note #' In case both `pos` or `pattern`, the latter is ignored. @@ -17,7 +17,7 @@ #' @return #' A character vector. #' -#' @importFrom magrittr %>% %<>% +#' @importFrom magrittr %>% #' @export #' @examples #' applyString('cool', pos = 1:2, FUN = toupper) @@ -25,14 +25,14 @@ applyString <- function(x, FUN, pos = NULL, pattern = NULL) { - - if (!is.character(x)) + + if (!is.character(x)) x <- as.character(x) - + if (!is.null(pos)) { tmp <- strsplit(x, split = "") tmp_fun <- function(x) { - x[pos] %<>% FUN + x[pos] <- FUN(x[pos]) paste(x, collapse = "") } out <- lapply(tmp, tmp_fun) %>% unlist @@ -50,7 +50,6 @@ applyString <- function(x, FUN, pos = NULL, pattern = NULL) { out <- apply(cbind(tmp_mth, tmp_inv), 1, FUN = reassemble, f = FUN) } } - out } @@ -61,7 +60,7 @@ reassemble <- function(x, f) { sz <- length(char1) + length(char2) out <- rep("", sz) out[seq(1, sz, 2)] <- char2 - if (sz > 1) + if (sz > 1) out[seq(2, sz - 1, 2)] <- f(x[1L][[1L]]) paste(out, collapse = "") } diff --git a/R/signifSymbols.R b/R/signifSymbols.R index 3016ab0..58b7e52 100644 --- a/R/signifSymbols.R +++ b/R/signifSymbols.R @@ -17,7 +17,7 @@ #' @examples #' signifSymbols(.012) #' signifSymbols(.008) -#' sapply(c(.2, .08, .04, .008, 0.0001), signifSymbols) +#' lapply(c(.2, .08, .04, .008, 0.0001), signifSymbols) signifSymbols <- function(pvalue, thresholds = c(0.1, 0.05, 0.01, 0.001), symbols = c(".", "*", "**", "***"), notsignif = "n.s.") { diff --git a/R/stApply.R b/R/stApply.R deleted file mode 100644 index 3d92f6f..0000000 --- a/R/stApply.R +++ /dev/null @@ -1,65 +0,0 @@ -#' Apply a function on elements of a character string -#' -#' Apply a function on a given set of elements of a character string. -#' -#' @author -#' Kevin Cazelles -#' -#' @param x a character vector, or a vector to be coerced to a character vector. -#' @param FUN the function to be applied, see [base::lapply]. -#' @param pos a vector indicating the elements position. -#' @param pattern a see [base::gregexpr]. -#' @param ... argument to be passed to `gregexpr`. -#' -#' @note -#' In case both `pos` or `pattern`, the latter is ignored. -#' -#' @return -#' A character vector. -#' @export -#' @examples -#' stApply('cool', pos = 1:2, FUN = toupper) -#' stApply(c('cool', 'pro'), pattern = 'o', FUN = toupper) - - -stApply <- function(x, FUN, pos = NULL, pattern = NULL) { - - if (!is.character(x)) - x <- as.character(x) - - if (!is.null(pos)) { - tmp <- strsplit(x, split = "") - tmp_fun <- function(x) { - x[pos] <- FUN(x[pos]) - paste(x, collapse = "") - } - out <- unlist(lapply(tmp, tmp_fun)) - } else { - if (is.null(pattern)) { - warning("neither pos nor pattern is defined", call. = FALSE) - out <- NULL - } else { - mat <- gregexpr(pattern = pattern, text = x) - tmp_mth <- regmatches(x, mat) - # NB: regmatches(x, mat, invert = TRUE) returns '' if first or last elements - # match the pattern. Therefore there is alwasy 2*n - 1 number of elements in the - # vector to be created (n being the size of tmp_inv elements). - tmp_inv <- regmatches(x, mat, invert = TRUE) - out <- apply(cbind(tmp_mth, tmp_inv), 1, FUN = reassemble, f = FUN) - } - } - - out -} - - -reassemble <- function(x, f) { - char1 <- unlist(x[[1L]]) - char2 <- unlist(x[[2L]]) - sz <- length(char1) + length(char2) - out <- rep("", sz) - out[seq(1, sz, 2)] <- char2 - if (sz > 1) - out[seq(2, sz - 1, 2)] <- f(x[1L][[1L]]) - paste(out, collapse = "") -} diff --git a/docs/News.html b/docs/News.html index 4a3bf88..85b1b53 100644 --- a/docs/News.html +++ b/docs/News.html @@ -160,7 +160,7 @@

strLength() => stLength()
  • -applyString() => stApply() +applyString() => stApply()
    • diff --git a/docs/articles/overview.html b/docs/articles/overview.html index 51b5a06..3865f8c 100644 --- a/docs/articles/overview.html +++ b/docs/articles/overview.html @@ -103,6 +103,7 @@

    LoremIpsum

    +

    It is sometime useful to have a piece of random text to play with, loremIpsum() display a piece of the commonly used placeholder text Lorem ipsum with the option of having a specific number of words.

    -
    +

    -stApply

    -
    stApply("cool", FUN = toupper, pos = 1:2)
+applyString

    +
    applyString("cool", FUN = toupper, pos = 1:2)
 R>>  [1] "COol"
-stApply(c("cool", "pro"),  pattern = "o", FUN = toupper)
+applyString(c("cool", "pro"), pattern = "o", FUN = toupper)
 R>>  [1] "cOOl" "prO"
     @@ -212,16 +213,16 @@

    Assign a category

    +R>> [1] 3 6 8 2 7 6 6 9 2 10 7 5 6 5 8 6 8 9 8 2 6 10 8 +R>> [24] 6 3 1 7 9 6 2 8 10 1 10 2 9 9 9 3 5

    @@ -246,11 +247,11 @@

    +R>> $ V1: num 0.6509 0.0158 0.3626 0.8394 0.9734 ... +R>> $ V2: chr "0.192" "0.6712" "0.3469" "0.9803" ...

    @@ -355,7 +356,7 @@

  • Adjust the size of a character string
  • Assign a symbol to a p-value
  • Add URL and icons
    • -
  • stApply
    • +
  • applyString
  • Extract digits from strings
    • diff --git a/docs/reference/applyString.html b/docs/reference/applyString.html index 0834dce..bb6343b 100644 --- a/docs/reference/applyString.html +++ b/docs/reference/applyString.html @@ -133,7 +133,7 @@

    Arg FUN -

    the function to be applied, see base::lapply.

    +

    the function to be applied, see base::lapply().

    pos @@ -141,11 +141,11 @@

    Arg pattern -

    a see base::gregexpr.

    +

    a pattern see base::gregexpr().

    ... -

    argument to be passed to gregexpr.

    +

    argument to be passed to base::gregexpr().

    diff --git a/docs/reference/index.html b/docs/reference/index.html index 290ca23..8163e50 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -284,12 +284,6 @@

    stApply()

    - -

    Apply a function on elements of a character string

    - -

    substrBib()

    diff --git a/docs/reference/signifSymbols.html b/docs/reference/signifSymbols.html index d2b8575..32147eb 100644 --- a/docs/reference/signifSymbols.html +++ b/docs/reference/signifSymbols.html @@ -152,7 +152,21 @@

    Arg

    Examples

    - 
    signifSymbols(.012)
    #> [1] "*"
    signifSymbols(.008)
    #> [1] "**"
    sapply(c(.2, .08, .04, .008, 0.0001), signifSymbols)
    #> [1] "n.s." "."    "*"    "**"   "***"
    + 
    signifSymbols(.012)
    #> [1] "*"
    signifSymbols(.008)
    #> [1] "**"
    lapply(c(.2, .08, .04, .008, 0.0001), signifSymbols)
    #> [[1]]
+#> [1] "n.s."
+#> 
+#> [[2]]
+#> [1] "."
+#> 
+#> [[3]]
+#> [1] "*"
+#> 
+#> [[4]]
+#> [1] "**"
+#> 
+#> [[5]]
+#> [1] "***"
+#>