minor updates, v0.1.7

.gitignore

@@ -13,10 +13,13 @@ tests/testthat/*.tif
 *.xml
 *.ovr
 *.jpg
+*.xlsx
 
 *.png
 *.svg
 *.exe
 src-x64/
 src-i386/
 inst/font
+
+*/temp

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: Ipaper
 Type: Package
 Title: Collection of personal practical R functions
-Version: 0.1.6.9000
+Version: 0.1.7
 Authors@R: person("Dongdong", "Kong", email = "[email protected]",
   role = c("aut", "cre"))
 Description: Awesome functions in R.
@@ -27,7 +27,7 @@ Imports:
     methods,
     parallel,
     doParallel,
-    foreach,
+    foreach, iterators,
     plyr,
     dplyr,
     clipr, 
@@ -38,7 +38,6 @@ Suggests:
     testthat (>= 2.1.0),
     knitr,
     rmarkdown,
-    iterators,
     sp,
     grid, 
     gridExtra

NAMESPACE

@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+export("%!in%")
 export("%<>%")
 export("%>%")
+export("%do%")
+export("%dopar%")
 export(GeomBoxplot2)
 export(InitCluster)
 export(OS_type)
@@ -31,14 +34,13 @@ export(clamp_min)
 export(code)
 export(code_ChrVec)
 export(contain)
-export(cut_levels)
+export(cut_plevels)
 export(data.table)
 export(dcast2)
 export(dir.show)
 export(dt_chr2num)
 export(dt_round)
 export(edit_r_profile_sys)
-export(ensemble_mean)
 export(facet_tag)
 export(file_ext)
 export(file_name)
@@ -59,17 +61,25 @@ export(git_commit_amend)
 export(git_push)
 export(git_set_remote)
 export(github)
+export(group_apply)
+export(group_upperEnvelope)
+export(icount)
 export(ifelse2)
+export(install_git)
 export(install_gitee)
+export(install_github)
 export(is.data.table)
 export(is_empty)
 export(is_wsl)
+export(iter)
 export(key_blind)
 export(killCluster)
 export(label_tag)
 export(last)
 export(listk)
 export(llply_par)
+export(make_date)
+export(make_dt)
 export(map)
 export(mapvalues)
 export(mark_outlier)
@@ -87,11 +97,13 @@ export(quantile_envelope)
 export(read_xlsx)
 export(read_xlsx2list)
 export(reorder_name)
+export(revalue)
 export(rm_empty)
 export(runningId)
 export(set_dim)
 export(set_dimnames)
 export(set_font)
+export(set_names)
 export(setwd_clip)
 export(sf_rect)
 export(showfig)
@@ -112,11 +124,11 @@ export(which.notna)
 export(which.notnull)
 export(write_clip2)
 export(write_fig)
-export(write_fig2ps)
 export(write_list2xlsx)
 export(write_sp2rgb)
 import(clipr)
 import(ggplot2)
+import(iterators)
 import(magrittr)
 import(openxlsx)
 import(readxl)
@@ -130,6 +142,8 @@ importFrom(dplyr,first)
 importFrom(dplyr,last)
 importFrom(dplyr,mutate)
 importFrom(foreach,"%do%")
+importFrom(foreach,"%dopar%")
+importFrom(foreach,foreach)
 importFrom(ggplot2,aes_string)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,ggplot_build)
@@ -153,6 +167,7 @@ importFrom(grid,textGrob)
 importFrom(jsonlite,fromJSON)
 importFrom(jsonlite,read_json)
 importFrom(jsonlite,write_json)
+importFrom(lubridate,make_date)
 importFrom(lubridate,yday)
 importFrom(lubridate,year)
 importFrom(lubridate,ymd)
@@ -171,6 +186,8 @@ importFrom(plyr,ddply)
 importFrom(plyr,llply)
 importFrom(purrr,map)
 importFrom(purrr,transpose)
+importFrom(remotes,install_git)
+importFrom(remotes,install_github)
 importFrom(rstudioapi,getActiveDocumentContext)
 importFrom(rstudioapi,getSourceEditorContext)
 importFrom(rstudioapi,modifyRange)

NEWS.md

@@ -1,9 +1,17 @@
+
+# Ipaper 0.1.7
+
+- Many functions are reexported in Ipaper, including `iterators`, `foreach`, `lubridate`,
+  `data.table`, `dplyr`, `remotes`. One Ipaper is enough.
+- Addin `select_word` works
+- Git functions works, add `git_commit`, `git_commit_amend`, `git_push`
+
 # Ipaper 0.1.4.9000
 
 * Added a `NEWS.md` file to track changes to the package.
 * `write_fig`: support multiple pages pdf
 
 # Ipaper 0.1.5.9000
 
-* `mkTRend_rcpp` is at least 6-fold faster
+* `mkTRend_rcpp` is at least 6-fold faster (moved to rtrend)
 * add `acf.fft`

R/Ipaper-package.R

@@ -2,7 +2,7 @@
 #' @name Ipaper
 #' @aliases Ipaper-package
 #' @docType package
-#' @keywords download paper DOI
+#' @keywords paper
 #' 
 #' @importFrom jsonlite fromJSON read_json
 #' @importFrom purrr map transpose

R/addin.R

@@ -127,7 +127,7 @@ key_blind <- function(){
     options_update(file_rstudio, options_rstudio)   
 }
 
-#' @importFrom foreach %do%
+#' @importFrom foreach %do% %dopar%
 #' @importFrom jsonlite write_json read_json
 #' @export
 options_update <- function(file, options.new) {

R/dplyr.R

@@ -1,6 +1,3 @@
-#' @export
-transpose <- purrr::transpose
-
 #' @title data.frame manipulating function by `dplyr::across`
 #' @name dt_tools
 NULL
@@ -20,3 +17,22 @@ dt_chr2num <- function(d) {
 }
 
 # https://stackoverflow.com/questions/54774280/plyrddply-equivalent-in-dplyr
+
+#' @export
+dcast2 <- function(d, by, value.var = "value", ...) {
+    vars_left <- setdiff(colnames(d), c(by, value.var)) %>% paste(collapse = "+")
+    vars_right <- by %>% paste(collapse = "+")
+    formula <- as.formula(sprintf("%s~%s", vars_left, vars_right))
+    dcast(d, formula, value.var = value.var, ...)
+}
+
+#' @export 
+make_dt <- function(..., ncol = 3) {
+    x <- list(...)
+    n <- length(x)
+    nrow <- floor(n / ncol)
+    lapply(1:nrow, function(i) {
+        ind <- seq((i - 1) * ncol + 1, i * ncol)
+        x[ind] %>% as.data.table()
+    }) %>% do.call(rbind, .)
+}

R/git.R

@@ -38,6 +38,25 @@ github <- function(path = getwd()) {
     system(cmd)
 }
 
+# #' @rdname install_gitee
+# #' @export
+# install <- install_local
+
+# #' @importFrom devtools document load_all
+# #' @export
+# load_all2 <- function(path = ".", ...){
+#     document(path, ...)
+#     load_all(path, ...)
+# }
+
+#' @importFrom remotes install_github
+#' @export
+remotes::install_github
+
+#' @importFrom remotes install_git
+#' @export
+remotes::install_git
+
 #' Attempts to install a package directly from gitee.
 #'
 #' @param Repository address in the format `username/repo[/subdir][@ref|#pull]`.
@@ -55,19 +74,3 @@ install_gitee <- function(repo) {
         install_git(url)
     }
 }
-
-# #' @rdname install_gitee
-# #' @export
-# install <- install_local
-
-# #' @rdname install_gitee
-# #' @importFrom remotes install_git install_github
-# #' @export
-# install_github <- install_github
-
-# #' @importFrom devtools document load_all
-# #' @export
-# load_all2 <- function(path = ".", ...){
-#     document(path, ...)
-#     load_all(path, ...)
-# }

R/upper_envelope.R → R/group_apply.R

@@ -1,33 +1,11 @@
-#' function to separate data to steps of x, obtain 95 quantile value for smooth
-#' @export
-upper_envelope <- function(x, y, step = 0.2, alpha = 0.95){
-    xrange <- range(x, na.rm = T)
-
-    brks <- seq(xrange[1], xrange[2], by = step)
-    n    <- length(brks)
-    xmid <- (brks[-n] + brks[-1])/2
-
-    brks[n] <- Inf
-
-    res <- numeric(n-1)*NA_real_
-
-    for (i in 1:(n-1)){
-        val_min <- brks[i]
-        val_max <- brks[i+1]
-
-        I <- x >= val_min & x < val_max
-        res[i] <- quantile(y[I], alpha, na.rm = T)
-    }
-
-    data.table(x = xmid, y = res)
-}
-
-#' ensemble_mean
+#' group_apply
 #' 
+#' @param chunk split data into nchunks, and apply `FUN` in every group
 #' @param FUN function of mean or median
+#' @param ... others to `FUN`
 #' 
 #' @export
-ensemble_mean <- function(x, y, step = 0.2, chunk=NULL, FUN = "mean") {
+group_apply <- function(x, y, step = 0.2, chunk=NULL, FUN = "mean", ...) {
     FUN <- get(FUN, mode="function")
 
     xrange <- range(x, na.rm = T)
@@ -60,3 +38,33 @@ ensemble_mean <- function(x, y, step = 0.2, chunk=NULL, FUN = "mean") {
     }
     data.table(x = xmid, y = res)
 }
+
+#' function to separate data to steps of x, obtain 95 quantile value for smooth
+#' 
+#' @rdname group_apply
+#' @export
+group_upperEnvelope <- function(x, y, step = 0.2, alpha = 0.95) {
+    xrange <- range(x, na.rm = T)
+
+    brks <- seq(xrange[1], xrange[2], by = step)
+    n <- length(brks)
+    xmid <- (brks[-n] + brks[-1]) / 2
+
+    brks[n] <- Inf
+
+    res <- numeric(n - 1) * NA_real_
+
+    for (i in 1:(n - 1)) {
+        val_min <- brks[i]
+        val_max <- brks[i + 1]
+
+        I <- x >= val_min & x < val_max
+        res[i] <- quantile(y[I], alpha, na.rm = T)
+    }
+
+    data.table(x = xmid, y = res)
+}
+
+#' @keywords internal
+#' @export
+upper_envelope <- group_upperEnvelope