Issues #164 and #165 and upgrade version.

Author: dbosak01

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: libr
 Type: Package
 Title: Libraries, Data Dictionaries, and a Data Step for R
-Version: 1.3.2
+Version: 1.3.3
 Author: David J. Bosak
 Maintainer: David Bosak <dbosak01@gmail.com>
 Description: Contains a set of functions to create data libraries,

NEWS.md

@@ -1,3 +1,6 @@
+# libr 1.3.3
+* Fixed issue where `lib_write()` was not detecting changes to datasets in libname.
+
 # libr 1.3.2
 * Fixed bug on `libname()` when there are file names with multiple dots.
 

R/dictionary.R

@@ -166,67 +166,4 @@ getDictionary <- function(x, dsnm) {
 }
 
 
-getDictionary_back <- function(x, dsnm) {
-  
-  ret <- NULL
-  rw <- NULL
-  usr_wdth <- c()
-  str_wdth <- c()
-  cntr <- 0
-  
-  for (nm in names(x)) {
-    
-    
-    
-    cntr <- cntr + 1
-    
-    lbl <- attr(x[[nm]], "label")
-    desc <- attr(x[[nm]], "description")
-    fmt <- paste(as.character(attr(x[[nm]], "format")), collapse = "\n")
-    jst <- attr(x[[nm]], "justify")
-    wdth <- attr(x[[nm]], "width")
-    
-    if (fmt == "")
-      fmt <- NA
-    
-    if (is.null(wdth)) {
-      if (length(x[[nm]]) > 0) {
-        str_wdth[cntr] <- ifelse(typeof(x[[nm]]) == "character", 
-                                 max(nchar(x[[nm]])),
-                                 NA) 
-      } else {
-        
-        str_wdth[cntr] <- NA
-      }
-      
-    } else {
-      usr_wdth[cntr] <- wdth 
-    }
-    
-    rw <- data.frame(Name = dsnm,
-                     Column = nm,
-                     Class = paste0(class(x[[nm]]), collapse = " "),
-                     Label = ifelse(!is.null(lbl), lbl, as.character(NA)),
-                     Description = ifelse(!is.null(desc), desc, as.character(NA)),
-                     Format = ifelse(!is.null(fmt), fmt, NA),
-                     Width = ifelse(!is.null(wdth), wdth, NA),
-                     Justify = ifelse(!is.null(jst), jst, as.character(NA)),
-                     Rows = nrow(x),
-                     NAs = sum(is.na(x[[nm]])))
-    
-    
-    if (is.null(ret))
-      ret <- rw
-    else 
-      ret <- rbind(ret, rw)
-    
-  }
-  
-  
-  if (length(usr_wdth) == 0)
-    ret[["Width"]] <- str_wdth
-  
-  return(ret)
-  
-}
 

R/libname.R

@@ -510,7 +510,10 @@ libname <- function(name, directory_path, engine = "rds",
         attr(dat, "extension") <- ext
         attr(dat, "path") <- fp
         attr(dat, "checksum") <- md5sum(fp)
-
+        sig <- captureSignatures(dat)
+        attr(dat, "length") <- sig$Length
+        attr(dat, "hex") <- sig$Hex
+        
         l[[nm]] <- dat
       }
     }
@@ -529,17 +532,19 @@ libname <- function(name, directory_path, engine = "rds",
 
 
 
-
 # Manipulation Functions --------------------------------------------------
 
-
 #' @title Load a Library into the Workspace
 #' @description The \code{lib_load} function loads a data library into
 #' an environment. The environment used is associated with the library at 
 #' the time it is created with the \code{\link{libname}} function.  
 #' When the \code{lib_load} function is called, the data frames/tibbles 
 #' will be loaded with <library>.<data set> syntax.  Loading the data frames
 #' into the environment makes them easy to access and use in your program.
+#' 
+#' Note that the \code{lib_load} function is optional, and calling the function
+#' is not needed to access data in the \code{libname}.  You may also access
+#' data directly from the \code{libname} using the dollar sign ($) syntax.
 #' @param x The data library to load.  
 #' @param filter One or more quoted strings to use as filters for the  
 #' data names to load into the workspace. For more than one filter string, 

R/utilities.R

@@ -196,13 +196,36 @@ writeData <- function(x, ext, file_path, force = FALSE) {
   # Compare checksums
   cs_comp <- cs1 == cs2
 
+  sig <- captureSignatures(x)
+  
+  # If passes, compare df to file
+  if (!force && cs_comp == TRUE) {
+    
+    al <- attr(x, "length")
+    ah <- attr(x, "hex")
+    
+    if (!is.null(al)) {
+      if (sig$Length != al)
+        cs_comp <- FALSE
+    }
+    
+    if (!is.null(ah)) {
+      
+      if (sig$Hex != ah)
+        cs_comp <- FALSE
+    }
+  }
+
+  
   if (ext == "csv") {
 
     if (!cs_comp | force) {
       if (file.exists(file_path))
         file.remove(file_path)
       write_csv(x, file_path, na = "")
       attr(x, "checksum") <- md5sum(file_path)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   } else if (ext == "rds") {
@@ -212,6 +235,8 @@ writeData <- function(x, ext, file_path, force = FALSE) {
         file.remove(file_path)
       write_rds(x, file_path)
       attr(x, "checksum") <- md5sum(file_path)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   } else if (tolower(ext) %in% c("rdata", "rda")) {
@@ -221,6 +246,8 @@ writeData <- function(x, ext, file_path, force = FALSE) {
         file.remove(file_path)
       save(x, file = file_path)
       attr(x, "checksum") <- md5sum(file_path)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   } else if (ext == "sas7bdat") {
@@ -239,6 +266,8 @@ writeData <- function(x, ext, file_path, force = FALSE) {
         file.remove(file_path)
       foreign::write.dbf(as.data.frame(x, stringsAsFactors = FALSE), file_path)
       attr(x, "checksum") <- md5sum(file_path)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   } else if (ext == "xpt") {
@@ -248,6 +277,8 @@ writeData <- function(x, ext, file_path, force = FALSE) {
         file.remove(file_path)
       write_xpt(x, file_path)
       attr(x, "checksum") <- md5sum(file_path)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   } else if (ext == "xlsx") {
@@ -257,6 +288,8 @@ writeData <- function(x, ext, file_path, force = FALSE) {
         file.remove(file_path)
       openxlsx::write.xlsx(x, file_path)
       attr(x, "checksum") <- md5sum(file_path)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   } else if (ext == "xls") {
@@ -272,6 +305,8 @@ writeData <- function(x, ext, file_path, force = FALSE) {
       attr(x, "extension") <- "xlsx"
       attr(x, "path") <- fp
       attr(x, "checksum") <- md5sum(fp)
+      attr(x, "length") <- sig$Length
+      attr(x, "hex") <- sig$Hex
     }
 
   }  
@@ -508,6 +543,37 @@ log_output <- function() {
 
 
 
+getBitSignature <- function(x) {
+  
+  spos <- x[1]
+  for (i in seq(2, length(x))) {
+    
+    spos <- xor(spos, x[i]) 
+  }
+  
+  return(spos)
+}
+
+
+captureSignatures <- function(dat) {
+  
+  ret <- list()
+  
+  att <- attributes(dat)
+  for (nm in names(att)) {
+    if (!nm %in% c("class", "name"))
+      attr(dat, nm) <- NULL
+  }
+  
+  idat <- serialize(dat, connection = NULL)
+  
+  ret$Length <- length(idat)
+  ret$Hex <- getBitSignature(idat)
+
+  return(ret)
+}
+
+
 # @noRd
 # standard_eval <- function() {
 #