remove logit() close #8 🔥~

.Rbuildignore

@@ -11,3 +11,6 @@ LICENSE
 record_updates.txt
 ^docs$
 ^_pkgdown\.yml$
+^doc$
+^Meta$
+^index.Rmd

.gitignore

@@ -37,3 +37,5 @@ vignettes/*.pdf
 # Temporary files created by R markdown
 *.utf8.md
 *.knit.md
+doc
+Meta

NAMESPACE

@@ -4,6 +4,8 @@ export(addURL)
 export(addWebIcon)
 export(adjustString)
 export(aggregateCol)
+export(applyString)
+export(assignClass2df)
 export(assignIds)
 export(categorize)
 export(dfTemplate)
@@ -19,7 +21,6 @@ export(grepReplace)
 export(keepWords)
 export(logistic)
 export(logistic2)
-export(logit)
 export(loremIpsum)
 export(meanAlong)
 export(multiMatch)
@@ -31,6 +32,7 @@ export(signifSymbols)
 export(squaretize)
 export(stApply)
 export(stLength)
+export(strLength)
 export(substrBib)
 export(whichIs)
 export(wordCount)

News.md

@@ -1,13 +1,21 @@
 # inSilecoMisc 0.1.3.9000
 
-## Changes in functions
+## Changes in documentation :pencil:
+
+- README simplified
+
+## Changes in functions :gear:
 
+- remove (see #8)
 - In `dfTemplate()` the values of argument `col_classes` are now checked, a test has been added.
 - In `dfTemplate()` `fill` is now a vector whose values are replicated so its length equals the number of columns.
 - In `dfTemplate()`, `col_classes` values are replicated so its length equals the number of columns.
 - In `dfTemplate()`, `fill` now determines the classes of the columns when `col_classes` if `NULL` which is the new default value.
 
 
+
+
+
 # inSilecoMisc 0.1.3
 
 ## Changes in the package structure

R/applyString.R

@@ -0,0 +1,67 @@
+#' 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.
+#'
+#' @importFrom magrittr %>% %<>%
+#' @export
+#' @examples
+#' applyString('cool',  pos = 1:2, FUN = toupper)
+#' applyString(c('cool', 'pro'),  pattern = 'o', FUN = toupper)
+
+
+applyString <- 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
+            paste(x, collapse = "")
+        }
+        out <- lapply(tmp, tmp_fun) %>% unlist
+    } 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 = "")
+}

R/assignClass2df.R

@@ -0,0 +1,35 @@
+#' Assign a class to a set of column of a data frame
+#'
+#' This function is designed to ease the changes of column's class
+#' of a given data frame.
+#'
+#' @param x a data frame or a R object to be coerced into a data frame.
+#' @param colid the identity of columns for which class are ti be changed.
+#' @param cls a character vector containing the classes' names to be used in the
+#' same order as colid. By default \code{cls} is repeated until its size equals
+#' \code{colid}'s size.
+#'
+#' @return
+#' A data.frame for which columns have the required classes.
+#'
+#' @importFrom magrittr %<>%
+#' @export
+#' @examples
+#' df1 <- matrix(signif(runif(20),4), ncol=2)
+#' df2 <- assignClass2df(df1, 2, 'character')
+#' str(df1)
+#' str(df2)
+
+
+assignClass2df <- function(x, colid, cls) {
+    ## 
+    x %<>% as.data.frame
+    stopifnot(colid %in% 1:ncol(x))
+    out <- x
+    sz <- length(colid)
+    cl <- rep(cls, length.out = sz)
+    ## 
+    for (i in 1:sz) out[, colid[i]] <- methods::as(x[, colid[i]], cl[i])
+    ## 
+    return(out)
+}

R/categorize.R

@@ -9,8 +9,6 @@
 #' @param lower A logical, if TRUE elements equal to a given threshold values are included in the lower category, default is FALSE.
 #' @return
 #' A vector countaining values standing for categories into which elements of x have fallen.
-#' @importFrom magrittr %>%
-#' @importFrom magrittr %<>%
 #' @export
 #' @examples
 #' categorize(stats::runif(40), categ=c(0.5,0.75))
@@ -21,7 +19,7 @@
 
 categorize <- function(x, categ, lower = FALSE) {
     ##
-    categ %<>% unique %>% sort
+    categ <- sort(unique(categ))
     ##
     out <- rep(1, length(x))
     ##

R/strLength.R

@@ -0,0 +1,23 @@
+#' Compute the length of a strings.
+#'
+#' Compute the length of a vector of strings.
+#'
+#' @author
+#' Kevin Cazelles
+#'
+#' @param s character vector or a object to be coered as a character vector.
+#' @param ignore a vector of characters to be ignored in the count.
+#'
+#' @export
+#'
+#' @examples
+#' strLength(c(123))
+#' strLength(c('/', 'four five'), ignore = c(" ", "f"))
+
+strLength <- function(s, ignore = "") {
+    s %<>% as.character
+    out <- strsplit(s, split = "") %>%
+      lapply(function(x) sum(! x %in% ignore)) %>%
+      unlist
+    out
+}

R/whichIs.R → R/whichIS.R

@@ -22,5 +22,5 @@
 whichIs <- function(x, y, isPattern = FALSE,  ...) {
     if (isPattern) {
       our <- lapply(x, function(x) which(grepl(pattern = x, y), ...))
-    } else  lapply(x, function(x) which(y == x, ...))
+    } else lapply(x, function(x) which(y == x, ...))
 }