v0.1.3

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: Ipaper
 Type: Package
 Title: Paper writing tools
-Version: 0.1.2
+Version: 0.1.3
 Authors@R: person("Dongdong", "Kong", email = "[email protected]",
   role = c("aut", "cre"))
 Description: Download papers batchly using DOIs from many database. And some practical functions.
@@ -13,6 +13,7 @@ Suggests: testthat,
     knitr,
     rmarkdown
 LinkingTo: 
+  Rcpp, RcppArmadillo
 Imports:
     httr,
     xml2,
@@ -26,6 +27,9 @@ Imports:
     openxlsx, readxl, 
     plyr, 
     reshape2,
-    graphics, methods
+    graphics, methods,
+    Rcpp,
+    parallel,
+    doParallel
 VignetteBuilder: knitr
-RoxygenNote: 6.1.0
+RoxygenNote: 6.1.1

NAMESPACE

@@ -1,23 +1,24 @@
 # Generated by roxygen2: do not edit by hand
 
+export(InitCluster)
 export(Init_Check)
-export(check_dir)
-export(clusterLCall)
-export(clusterSCall)
-export(cluster_Init)
+export(box_qtl)
 export(df2sp)
 export(dir.show)
 export(download_aria2)
 export(download_httr)
+export(ensemble_mean)
 export(extractId)
 export(fprintf)
 export(getDOIs_endnote)
 export(getPointsMODISTile)
-export(get_files)
 export(get_grid)
 export(get_sbatch)
 export(getwd_clip)
+export(ggplot_legend)
+export(github)
 export(gridSaveToPoly)
+export(killCluster)
 export(makeVIDEO)
 export(melt_list)
 export(pal)
@@ -28,7 +29,6 @@ export(read_json.gee)
 export(read_jsons.gee)
 export(readxlsx_ToList)
 export(runningId)
-export(selectHost)
 export(setwd_clip)
 export(src_AMS)
 export(src_IOP)
@@ -39,28 +39,35 @@ export(src_Springer)
 export(src_URL)
 export(src_hess)
 export(src_wiley_I)
-export(sysinfo)
+export(subl)
+export(tidy_file)
+export(upper_envelope)
+export(which.na)
+export(which.notna)
+export(write_fig)
+export(write_fig2ps)
 export(write_urls)
 export(write_webfile)
 export(writelist_ToXlsx)
 import(httr)
 import(magrittr)
 import(openxlsx)
-import(parallel)
 import(plyr)
 import(readxl)
 import(xml2)
+importFrom(Rcpp,sourceCpp)
 importFrom(data.table,as.data.table)
 importFrom(data.table,data.table)
 importFrom(data.table,fwrite)
 importFrom(data.table,is.data.table)
 importFrom(data.table,setkeyv)
-importFrom(graphics,plot)
+importFrom(doParallel,registerDoParallel)
 importFrom(graphics,rect)
 importFrom(jsonlite,fromJSON)
 importFrom(jsonlite,read_json)
 importFrom(maptools,readShapePoly)
 importFrom(methods,as)
+importFrom(parallel,makeCluster)
 importFrom(parallel,mclapply)
 importFrom(plyr,llply)
 importFrom(purrr,is_empty)
@@ -82,3 +89,4 @@ importFrom(sp,proj4string)
 importFrom(stringr,str_extract)
 importFrom(utils,URLdecode)
 importFrom(utils,write.table)
+useDynLib(Ipaper, .registration = TRUE)

R/RcppExports.R

@@ -0,0 +1,7 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+split_array <- function(x) {
+    .Call(`_Ipaper_split_array`, x)
+}
+

R/box_qtl.R

@@ -0,0 +1,5 @@
+#' @export
+box_qtl <- function(x){
+    x <- stats::na.omit(x)
+    quantile(x, c(0.1, 0.9)) %>% set_names(c("ymin", "ymax"))
+}

R/excel.R

@@ -47,13 +47,13 @@ readxlsx_ToList <- function(file, ...){
   cat(sprintf("[---- Reading File: %s ----]\n", file))
   ## judge whether it's xls or xlsx
   #  if file is *.xls use readxl::read_excel
-  if (length(grep("xls", basename(file))) != 0){
+  if (length(grep("xls$", basename(file))) != 0){
     sheetNames <- excel_sheets(file)
     x <- llply(sheetNames, function(sheet) as.data.frame(read_excel(file, sheet, ...)),
                .progress = "text")
   }else{
     sheetNames <- getSheetNames(file)
-    x <- llply(sheetNames, function(sheet) read.xlsx(file, sheet),
+    x <- llply(sheetNames, function(sheet) read.xlsx(file, sheet, ...),
                .progress = "text")
   }
   names(x) <- sheetNames

R/ggplot_legend.R

@@ -0,0 +1,7 @@
+#' @export
+ggplot_legend<-function(g){
+    tmp <- ggplot_gtable(ggplot_build(g))
+    leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
+    legend <- tmp$grobs[[leg]]
+    return(legend)
+}

R/list.R

@@ -25,4 +25,4 @@ melt_list <- function(list, var.name, na.rm = TRUE, ...){
         colnames(res) <- c(id.vars, var.name)
     }
     return(res)
-}
+}

R/parallel_init.R

@@ -0,0 +1,25 @@
+#' @export
+killCluster <- function() system("taskkill /IM Rscript.exe -f")
+
+#' @importFrom doParallel registerDoParallel
+#' @importFrom parallel makeCluster
+#' @export
+InitCluster <- function(ncluster = 4, outfile = "log.txt"){
+    # file_log <- "outfile.txt"
+    if (file.exists(outfile)) file.remove(outfile)
+    cl <- makeCluster(ncluster, outfile = outfile)
+    registerDoParallel(cl)
+}
+
+# #' @import doFuture 
+# #' @importFrom future makeClusterPSOCK plan
+# #' @export
+# InitCluster2 <- function(ncluster = 4, outfile = "log.txt"){
+#     # file_log <- "outfile.txt"
+#     if (file.exists(outfile)) file.remove(outfile)
+
+#     registerDoFuture()
+
+#     cl <- makeClusterPSOCK(ncluster, outfile = outfile)
+#     plan(cluster, workers = cl)
+# }

R/parallel_makePSOCKcluster.R

@@ -1,3 +1,4 @@
+#' @import parallel
 makePSOCKcluster <- function(names, ...)
 {
     newPSOCKnode <- function(machine = "localhost", ...,

R/parallel_sbatch.R

@@ -17,7 +17,8 @@
 #' @export
 par_sbatch <- function(X, FUN, ..., 
                        return.res = F, Save = F, 
-                       outdir = '.', prefix = 'results_', overwrite = T)
+                       outdir = '.', prefix = 'results_', overwrite = T, 
+                       cpus_per_node = NULL)
 {
     nparams <- length(X)
     # NODES, CPUS_PER_NODE are defined in sbatch file
@@ -31,13 +32,18 @@ par_sbatch <- function(X, FUN, ...,
     # determines how many processes are run in parallel per node.
     I_node        <- as.numeric(Sys.getenv('SLURM_ARRAY_TASK_ID')) #node ID
     nodes         <- as.numeric(Sys.getenv('SLURM_JOB_NUM_NODES'))
-    cpus_per_node <- as.numeric(Sys.getenv('SLURM_CPUS_ON_NODE'))
+
+    if (is.null(cpus_per_node)){
+        cpus_per_node <- as.numeric(Sys.getenv('SLURM_CPUS_ON_NODE'))
+    }
 
     if (is.na(I_node)) I_node <- 0 # sinteractive mode
     if (is.na(nodes))  nodes  <- 1
     if (is.na(cpus_per_node)) cpus_per_node <- 1
 
-    outfile = paste0(outdir, '/', prefix, I_node, '.RDS')
+    str_node <- ifelse(nodes > 1, I_node, "")
+    outfile = paste0(outdir, '/', prefix, str_node, '.RDS')
+
     if (Save && file.exists(outfile) && !overwrite) return(NULL)
 
     if (nparams < cpus_per_node * nodes) {
@@ -93,7 +99,7 @@ par_sbatch <- function(X, FUN, ...,
 #' 
 #' @export
 get_sbatch <- function(indir = '.', pattern = 'result.*.RDS',
-                          Save = TRUE, outfile = "result.rda"){
+                          outfile = NULL, Save = !is.null(outfile)){
     files <- dir(indir, pattern, full.names = T)
     cat('OUTPUTs:', "\n")
     print(basename(files))

R/spatial.R

@@ -23,23 +23,23 @@ df2sp <- function (d, formula = ~lon + lat, prj){
 
 #' extractId
 #' 
-#' @param station A data.frame with the station coordinates information
+#' @param sp A SpatialPointDataFrame with the station coordinates information
 #' @param shpfile A character, shape file path.
 #' @inheritParams df2sp
 #' 
 #' @importFrom maptools readShapePoly
 #' @importFrom sp SpatialPolygons over
 #' @export
-extractId <- function(station, shpfile, formula = ~lon+lat){
-    sp    <- df2sp(station, formula, prj84)
-
+extractId <- function(sp, shpfile){
+    # formula <- ~lon+lat
+    # sp    <- df2sp(station, formula, prj84)
     shp   <- readShapePoly(shpfile, proj4string = prj84)
     bound <- SpatialPolygons(shp@polygons, proj4string = prj84)
     ## clipped station
-    clipId <- which(!is.na(over(station, bound))) %>% as.numeric
+    clipId <- which(!is.na(over(sp, bound))) %>% as.numeric
 
     plot(shp, axes = T)
-    plot(station[clipId, ], add = T)
+    plot(sp[clipId, ], add = T)
     clipId#return clipId
 }
 
@@ -71,7 +71,8 @@ get_grid <- function(range, cellsize, midgrid = c(TRUE, TRUE), prj = prj84) {
     }
 
     offset  <- c(long_range[1], lat_range[1]) + cellsize/2 * (midgrid)
-    dims    <- c(diff(long_range), diff(lat_range)) / cellsize + !midgrid
+    dims    <- {c(diff(long_range), diff(lat_range)) / cellsize + !midgrid} %>% 
+      ceiling()
 
     grid <- GridTopology(
         cellcentre.offset = offset,

R/srcFUN.R → R/src_FUN.R

@@ -175,4 +175,4 @@ src_hess <- function(doi){
   paste0("http://www.hydrol-earth-syst-sci.net/", 
          gsub("hess-", "", doi) %>% gsub("-", "/", .), "/", 
          doi, ".pdf")
-}
+}

R/write_download.R → R/src_download.R

@@ -7,7 +7,6 @@
 # library(magrittr)
 # library(stringr)
 
-# source("E:/GitHub/RCurl_project/R/MainFunction.R", encoding = "utf-8")
 # httpheader: used to cheat web server
 header <- "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/62.0.3202.94 Safari/537.36"
 
@@ -188,4 +187,4 @@ download_httr <- function(DOIs, journal = '.', srcFUN = NULL, ...){
     src <- srcFUN(DOIs[i], ...)
     write_webfile(src, outdir = paste0(journal, "/"))
   }
-}
+}

R/subl.R

@@ -0,0 +1,13 @@
+#' subl
+#' @export
+subl <- function(path = getwd()){
+    cmd <- sprintf('subl %s', path)
+    system(cmd)
+}
+
+#' github
+#' @export
+github <- function(path = getwd()){
+    cmd <- sprintf('github %s', path)
+    system(cmd)
+}

R/parallel_remote_functions.R → R/temp/parallel_remote_functions.R

@@ -7,14 +7,14 @@
 #' @param vars common variables for every cluster
 #' @param expr expressions to be evaluated for every cluster
 #' 
-#' @import parallel
 #' @examples 
 #' \dontrun{
 #' cluster_Init(pkgs = "httr",
 #'      expr = source("R/mainfunc/main.R", encoding = "utf-8"))
 #' }
 #' @export
 cluster_Init <- function(ncluster = 4, pkgs, vars, expr) {
+    e <- parent.frame()
     cl <- makeCluster(ncluster, type = "SOCK", outfile = "log.txt")
     pkgs_Init <- function(pkgs) {
         for (i in pkgs) 
@@ -24,11 +24,11 @@ cluster_Init <- function(ncluster = 4, pkgs, vars, expr) {
         clusterCall(cl, pkgs_Init, pkgs)
     }
     if (!missing(vars)){
-        clusterExport(cl, vars, envir = environment())
+        clusterExport(cl, vars, envir = e)
     }
     if (!missing(expr)){
         # clusterEvalQ(cl, expr = expr)
-        clusterCall(cl, eval, substitute(expr), env = .GlobalEnv)
+        clusterCall(cl, eval, substitute(expr), env = e)
     }
     assign("cl", cl, envir = .GlobalEnv)
 

R/tidy_file.R

@@ -0,0 +1,4 @@
+#' @export
+tidy_file <- function(file) {
+    gsub("file:///", "", file)
+}