Autodetect symlink; disabled symlink by default; added header signatures; check header signatures when binding; doc fixes

Author: dipterix

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: filearray
 Type: Package
 Title: File-Backed Array for Out-of-Memory Computation
-Version: 0.1.2.9000
+Version: 0.1.3
 Language: en-US
 Encoding: UTF-8
 License: LGPL-3
@@ -17,7 +17,8 @@ Description: Stores large arrays in files to avoid occupying large
     reading/writing via 'OpenMP'. Supports multiple non-character data 
     types (double, float, complex, integer, logical, and raw).
 Imports: 
-    methods, 
+    digest (>= 0.6.29),
+    methods,
     Rcpp
 Suggests: 
     rmarkdown,

NEWS.md

@@ -1,5 +1,21 @@
 # filearray (development version)
 
+# filearray 0.1.3
+
+* Automatically detect whether symbolic-link works and show warnings
+* Warnings can be suppressed
+* Allow extra headers to be set in `meta` file
+* Added header signature method
+* Fixed symbolic-link issues on `Windows` when partition sizes are 0
+* Added check-load function `filearray_checkload` to validate header
+* Fixed collapse method when `dimnames` are set
+* Fixed an unprotected variable in `C++` code
+* `filearray_bind` can use cache if the header signatures agree
+* `filearray_bind` can choose to force overwrite
+* Added package `digest` to `Imports`
+* Fixed a typo and several small bugs
+
+
 # filearray 0.1.2
 
 * Removed `flush` in saving data to let system decide when to flush to hard drive

R/bind.R

@@ -6,7 +6,13 @@
 #' @param symlink whether to use \code{\link[base]{file.symlink}}; if true,
 #' then partition files will be symbolic-linked to the original arrays,
 #' otherwise the partition files will be copied over. If you want your data
-#' to be portable, do not use symbolic-links. 
+#' to be portable, do not use symbolic-links. The default value is \code{FALSE}
+#' @param overwrite whether to overwrite when \code{filebase} already exists;
+#' default is false, which raises errors
+#' @param cache_ok see 'Details', only used if \code{overwrite} is true.
+#' 
+#' @return A bound array in \code{'FileArray'} class.
+#' 
 #' @details The input arrays must share the same data type and partition size.
 #' The dimension for each partition should also be the same. For example
 #' an array \code{x1} has dimension \eqn{100x20x30} with partition size 
@@ -16,9 +22,26 @@
 #' \eqn{100x20x40} and each partition size is \code{1}, then \code{x1} and 
 #' \code{x2} can be merged.
 #' 
-#' The \code{symlink} option should be used with caution. Creating symbolic
-#' links is definitely faster than copying partition files. However, since 
-#' the partition files are simply linked to the original partition files, 
+#' If \code{filebase} exists and \code{overwrite} is \code{FALSE}, an error will 
+#' always raise. If \code{overwrite=TRUE} and \code{cache_ok=FALSE}, then
+#' the existing \code{filebase} will be erased and any data stored within will
+#' be lost. 
+#' If both \code{overwrite} and \code{cache_ok} are \code{TRUE}, then 
+#' , before erasing \code{filebase}, the function validates the existing
+#' array header and compare the header signatures. If the existing header
+#' signature is the same as the array to be created, then the existing array 
+#' will be returned. This \code{cache_ok} could be extremely useful when
+#' binding large arrays with \code{symlink=FALSE} as the cache might avoid
+#' moving files around. However, \code{cache_ok} should be enabled with caution.
+#' This is because only the header information will be compared, but the 
+#' partition data will not be compared. If the existing array was generated from
+#' an old versions of the source arrays, but the data from the source arrays
+#' has been altered, then the \code{cache_ok=TRUE} is rarely proper as the cache
+#' is outdated.
+#' 
+#' The \code{symlink} option should be used with extra caution. Creating 
+#' symbolic links is definitely faster than copying partition files. However, 
+#' since the partition files are simply linked to the original partition files, 
 #' changing to the input arrays will also affect the merged arrays, and 
 #' vice versa; see 'Examples'. Also for arrays created from symbolic links, if 
 #' the original 
@@ -63,9 +86,12 @@
 #' @export
 filearray_bind <- function(
     ..., .list = list(), filebase = tempfile(), 
-    symlink = FALSE
+    symlink = FALSE, overwrite = FALSE, cache_ok = FALSE
 ){
-    if(symlink && !getOption("filearray.symlink_enabled", FALSE)){
+    stopifnot(length(filebase) == 1)
+    symlink <- as.logical(symlink)[[1]]
+    # options("filearray.symlink_enabled" = TRUE)
+    if(symlink && !getOption("filearray.symlink_enabled", symlink_enabled())){
         symlink <- FALSE
         quiet_warning("Symbolic link is disabled. Force `symlink` to be FALSE")
     }
@@ -110,16 +136,65 @@ filearray_bind <- function(
 
     dim[[length(dim)]] <- sum(last_margin) * part_size
 
-    re <- filearray_create(filebase = filebase, dimension = dim, type = type, partition_size = part_size)
-    
+    # Dry-run
     start <- 1
     end <- 1
 
     bind_info <- list(
         is_bound = TRUE,
-        symlink = as.logical(symlink)
+        dimension = as.double(dim), 
+        type = type, 
+        partition_size = as.double(part_size),
+        partition_header_signatures = sapply(arrays, function(y){ y$header_signature(include_path = TRUE) })
     )
+    bind_signature <- digest::digest(bind_info, algo = "sha256")
+    
     source_info <- list()
+    for(ii in seq_along(last_margin)){
+        arr <- arrays[[ii]]
+        end <- start -1 + last_margin[[ii]]
+        idx <- seq.int(start, end)
+        source_info[[ii]] <- arr$partition_path(seq_len(last_margin[[ii]]))
+        start <- end + 1
+    }
+    bind_info$source_info <- source_info
+    bind_info$symlink  <- symlink
+    
+    if(file.exists(filebase)) {
+        
+        if(!overwrite){
+            stop("Array has already existed at: ", filebase)
+        } 
+        
+        if(cache_ok){
+            check <- tryCatch({
+                check <- FALSE
+                if(file.exists(file.path(filebase, "meta"))){
+                    header <- load_meta(filebase)
+                    if(
+                        identical(header$filearray_bind_signature, bind_signature) &&
+                        identical(header$filearray_bind$symlink, symlink)
+                    ){
+                        check <- TRUE
+                    }
+                }
+                check
+            }, error = function(e){
+                FALSE
+            })
+            if(check){
+                re <- filearray_load(filebase = filebase, mode = "readonly")
+                attr(re, "cached_bind") <- TRUE
+                return(re)
+            }
+        }
+        
+        unlink(filebase, recursive = TRUE)
+    }
+    re <- filearray_create(filebase = filebase, dimension = dim, type = type, partition_size = part_size)
+    
+    start <- 1
+    end <- 1
 
     for(ii in seq_along(last_margin)){
         arr <- arrays[[ii]]
@@ -136,15 +211,12 @@ filearray_bind <- function(
                 re$partition_path(idx)
             )
         }
-        source_info[[ii]] <- arr$partition_path(seq_len(last_margin[[ii]]))
-        
         start <- end + 1
     }
 
-    if(symlink){
-        bind_info$source_info <- source_info
-    }
-    re$set_header("filearray_bind", bind_info)
+    re$.header$filearray_bind <- bind_info
+    re$.header$filearray_bind_signature <- bind_signature
+    re$.save_header()
 
     if(symlink){
         re$.mode <- "readonly"

R/class_filearray.R

@@ -216,6 +216,16 @@ setRefClass(
             .self$.header[[key]] <- value
             .self$.save_header()
         },
+        header_signature = function(include_path = TRUE){
+            header_sig <- digest::digest(.self$.header, algo = "sha256")
+            if( include_path ){
+                path <- normalizePath(.self$.filebase)
+                header_sig <- digest::digest(c(
+                    header_sig, path
+                ), algo = "sha256")
+            }
+            header_sig
+        },
         load = function(filebase, mode = c('readwrite', 'readonly')){
             mode <- match.arg(mode)
 

R/filearray-package.R

@@ -40,6 +40,49 @@ in_rcmdcheck <- function (...) {
     return(FALSE)
 }
 
+symlink_enabled <- local({
+    enabled <- NA
+    function(){
+        if(!is.na(enabled)){ return(enabled) }
+        tempdir(check = TRUE)
+        f1 <- tempfile(pattern = 'filearray_simlink_test_from')
+        f2 <- tempfile(pattern = 'filearray_simlink_test_to')
+        on.exit({
+            if(file.exists(f1)){
+                unlink(f1)
+            }
+            if(file.exists(f2)){
+                unlink(f2)
+            }
+        }, add = FALSE)
+        s <- paste(sample(LETTERS), collapse = "")
+        writeLines(s, con = f1)
+        file.symlink(f1, to = f2)
+        en <- tryCatch({
+            if(identical(readLines(f2), s)){
+                TRUE
+            } else {
+                FALSE
+            }
+        }, error = function(e){
+            FALSE
+        }, warning = function(e){
+            FALSE
+        })
+        enabled <<- en
+        
+        if(file.exists(f1)){
+            unlink(f1)
+        }
+        if(file.exists(f2)){
+            unlink(f2)
+        }
+        on.exit({}, add = FALSE)
+        
+        return(enabled)
+    }
+})
+
 
 .onLoad <- function(libname, pkgname){
     if(hasOpenMP()){

R/zzz.R

@@ -1,13 +1,3 @@
-## Reasons:
-
-* Bug fix
-* Fixed a violation of CRAN policy mentioned by Prof. Ripley by restricting 
-number of CPU cores to 2 in R checks:
-
-```
-using 8 threads is a serious violation of the CRAN policy,
-```
-
 ## Dev environment 
 * osx (ARM), R 4.1.2
 
@@ -19,7 +9,7 @@ using 8 threads is a serious violation of the CRAN policy,
 
 ## R CMD check results
 
-On R-4.1 and `devel`
+On `release` and `devel`
 0 errors | 0 warnings | 0 notes
 
 On R-4.0