Uses future vs. parallel

.github/workflows/R-CMD-check.yaml

@@ -1,84 +1,29 @@
-# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag.
-# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches:
-      - main
-      - master
+    branches: [main, master]
   pull_request:
-    branches:
-      - main
-      - master
+    branches: [main, master]
 
 name: R-CMD-check
 
 jobs:
   R-CMD-check:
-    runs-on: ${{ matrix.config.os }}
-
-    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
-
-    strategy:
-      fail-fast: false
-      matrix:
-        config:
-          - {os: windows-latest, r: 'release'}
-          - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-          - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-
+    runs-on: ubuntu-latest
     env:
-      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
-      RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-
+      R_KEEP_PKG_SOURCE: yes
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
-          r-version: ${{ matrix.config.r }}
-
-      - uses: r-lib/actions/setup-pandoc@v1
+          use-public-rspm: true
 
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Cache R packages
-        if: runner.os != 'Windows'
-        uses: actions/cache@v2
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
-        run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
-
-      - name: Install dependencies
-        run: |
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
+          extra-packages: any::rcmdcheck
+          needs: check
 
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_REMOTE_: false
-        run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
-
-      - name: Upload check results
-        if: failure()
-        uses: actions/upload-artifact@main
-        with:
-          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check
+      - uses: r-lib/actions/check-r-package@v2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: adept
 Type: Package
 Title: Adaptive Empirical Pattern Transformation 
-Version: 1.2
+Version: 1.3.0
 Authors@R: c(
   person("Marta", "Karas", email = "marta.karass@gmail.com", role = c("aut", "cre"), 
       comment = c(ORCID = "0000-0001-5889-3970")),
@@ -19,7 +19,7 @@ Description: Designed for optimal use in performing fast,
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.3.2
 URL: https://github.com/martakarass/adept
 BugReports: https://github.com/martakarass/adept/issues
 Depends: R (>= 2.10)
@@ -41,5 +41,8 @@ Imports:
     magrittr,
     dvmisc,
     parallel,
-    pracma
+    pracma,
+    assertthat,
+    future,
+    furrr
 Language: en-US

R/maxAndTune.R

@@ -115,7 +115,9 @@ finetune_maxima <- function(s.TMP,
   tau2.nbh.x  <- finetune.maxima.x[tau2.nbh]
   x.mat       <- outer(tau2.nbh.x, tau1.nbh.x, FUN = "+")
   x.mat.VALID <- x.mat * tau12.mat.VALID
-  which.out   <- which(x.mat.VALID == max(x.mat.VALID), arr.ind = TRUE)[1,]
+  which.out   <- which.max(x.mat.VALID)
+  which.out = arrayInd(which.out,
+                       .dim = dim(x.mat.VALID))
 
   ## Define "tuned" start and end index point of identified pattern occurence
   ## within a time-series \code{x}
@@ -219,10 +221,12 @@ maxAndTune <- function(x,
   out.list <- list()
   x.Fitted <- rep(NA, x.vl)
 
+  run_template_idx = !(is.null(template.idx.mat))
+  finetune_is_maxima = !is.null(finetune) && finetune == "maxima"
   ## -------------------------------------------------------------------------
   ## Fine-tuning components
 
-  if (!is.null(finetune) && finetune == "maxima"){
+  if (finetune_is_maxima) {
     nbh.wing <- floor((finetune.maxima.nbh.vl + (finetune.maxima.nbh.vl %% 2) - 1)/2)
   }
   ## -------------------------------------------------------------------------
@@ -235,36 +239,45 @@ maxAndTune <- function(x,
     # if (max.empty < template.vl.min){
     #   break
     # }
-    if (all(is.na(similarity.mat))){
-      break
-    }
+    # if (all(is.na(similarity.mat))){
+    #   break
+    # }
 
-    ## Determine current maximum value in similarity matrix
-    similarity.mat.MAX <- max(similarity.mat, na.rm = TRUE)
-    if (similarity.mat.MAX < similarity.measure.thresh) {
-      break
-    }
 
     ## Identify parameters s and tau corresponding to maximum of covariance matrix
     ## s:   expressed as vector length
     ## tau: expressed as index of x vector
     ## Mar 5, 2019 @MK: fix the discrepancies caused by floating precision
     ## May 5, 2019 @MK: restore the previous code line here
-    similarity.mat.MAX.IDX <- which(similarity.mat == similarity.mat.MAX, arr.ind = TRUE)[1, ]
+    # get the index first, then check
+    similarity.mat.MAX.IDX <- which.max(similarity.mat)
+    similarity.mat.MAX = similarity.mat[similarity.mat.MAX.IDX]
+    ## Determine current maximum value in similarity matrix
+    # similarity.mat.MAX <- max(similarity.mat, na.rm = TRUE)
+    if (length(similarity.mat.MAX) == 0 ||
+        length(similarity.mat.MAX.IDX) == 0 ||
+        similarity.mat.MAX < similarity.measure.thresh) {
+      break
+    }
+
+    # turn into row/column
+    similarity.mat.MAX.IDX = arrayInd(similarity.mat.MAX.IDX,
+                                      .dim = dim(similarity.mat))
     # similarity.mat.MAX.IDX <- which(similarity.mat + tol > similarity.mat.MAX, arr.ind = TRUE)[1, ]
     tau.TMP     <- similarity.mat.MAX.IDX[2]
     s.TMP       <- template.vl[similarity.mat.MAX.IDX[1]]
 
+
     ## Identify
-    if (!(is.null(template.idx.mat))){
+    if (run_template_idx){
       template.idx.TMP <- template.idx.mat[similarity.mat.MAX.IDX[1], similarity.mat.MAX.IDX[2]]
     }
 
 
     ## -------------------------------------------------------------------------
     ## Fine-tuning
 
-    if (!is.null(finetune) && finetune == "maxima"){
+    if (finetune_is_maxima){
       finetune.out <- finetune_maxima(s.TMP,
                                       tau.TMP,
                                       nbh.wing,
@@ -278,13 +291,14 @@ maxAndTune <- function(x,
     ## -------------------------------------------------------------------------
 
 
+    # get the max cols, outside loop because does not use i or s.i
+    NArepl.cols.max <- tau.TMP + s.TMP - 2
+    NArepl.cols.max <- min(max(1, NArepl.cols.max), x.vl)
     ## Fill similarity matrix with NA's at locations populated by an identified pattern
     for (i in 1:mat.nrow){
       s.i <-  template.vl[i]
       NArepl.cols.min <- tau.TMP - s.i + 2
       NArepl.cols.min <- min(max(1, NArepl.cols.min), x.vl)
-      NArepl.cols.max <- tau.TMP + s.TMP - 2
-      NArepl.cols.max <- min(max(1, NArepl.cols.max), x.vl)
       NArepl.cols     <- NArepl.cols.min:NArepl.cols.max
       # print(NArepl.cols)
       similarity.mat[i, NArepl.cols] <- NA
@@ -294,13 +308,17 @@ maxAndTune <- function(x,
     x.Fitted[(tau.TMP + 1):(tau.TMP + s.TMP - 2)] <- 1
 
     ## Store current iteration-specific results
-    out.list[[length(out.list) + 1]] <- c(tau.TMP, s.TMP, similarity.mat.MAX, template.idx.TMP)
+    out.list[[length(out.list) + 1]] <- data.frame(
+      tau_i = tau.TMP, T_i = s.TMP,
+      sim_i = similarity.mat.MAX,
+      template_i = template.idx.TMP)
 
   }
 
   ## List to data frame
-  out.df <- as.data.frame(do.call(rbind, out.list))
-  if (nrow(out.df) > 0) names(out.df) <- c("tau_i", "T_i", "sim_i", "template_i")
+  # out.df <- as.data.frame(do.call(rbind, out.list))
+  out.df <- dplyr::bind_rows(out.list)
+  # if (nrow(out.df) > 0) names(out.df) <- c("tau_i", "T_i", "sim_i", "template_i")
 
   return(out.df)