Merge pull request #23 from JanMarvin/datetimes

[R/readsav & readpor] convert to datetime if required. closes #22

.lintr

@@ -1,11 +1,9 @@
 linters: with_defaults(
-  line_length_linter = NULL, 
+  line_length_linter = NULL,
   cyclocomp_linter = NULL,
   commented_code_linter = NULL,
-  snake_case_linter = NULL,
   object_name_linter = NULL,
   trailing_whitespace_linter = NULL,
   commas_linter = NULL,
-  paren_brace_linter = NULL,
   trailing_whitespace_linter = NULL
   )

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: readspss
 Type: Package
 Title: Importing and Exporting SPSS Files
-Version: 0.15.2
+Version: 0.16.1
 Authors@R: c(
     person("Jan Marvin", "Garbuszus",
     email = "[email protected]", role = c("aut", "cre")),
@@ -34,4 +34,4 @@ SystemRequirements: OpenSSL >= 1.0.1
 VignetteBuilder: knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0

R/readpor.R

@@ -64,7 +64,7 @@ read.por <- function(file, convert.factors = TRUE, generate.factors = TRUE,
 
   file <- file_ext(basename(filepath))
 
-  if ((tolower(file) != "por") &
+  if ((tolower(file) != "por") &&
       !isTRUE(override)) {
     warning("Filending is not por.
              Use Override if this check should be ignored.")
@@ -220,7 +220,7 @@ read.por <- function(file, convert.factors = TRUE, generate.factors = TRUE,
           varunique <- na.omit(unique(data[[varname]]))
         }
 
-        if (isNum | all(is.na(labtable))) {
+        if (isNum || all(is.na(labtable))) {
           nam <- names(labtable)
           labtable <- as.numeric(labtable)
           names(labtable) <- nam
@@ -261,11 +261,14 @@ read.por <- function(file, convert.factors = TRUE, generate.factors = TRUE,
   }
 
 
+
+
   if (convert.dates) {
 
     nams   <- names(data)
-    isdate <- fmt[, 1] %in% c(20, 22, 23, 24, 38, 39)
-    istime <- fmt[, 1] %in% c(21, 25)
+    isdate <- fmt[, 1] %in% c(20, 23, 24, 28, 29, 30, 38, 39)
+    isdatetime <- fmt[, 1] %in% c(22, 41)
+    istime <- fmt[, 1] %in% c(21, 25, 40)
 
     if (any(isdate)) {
       for (nam in nams[isdate]) {
@@ -276,12 +279,20 @@ read.por <- function(file, convert.factors = TRUE, generate.factors = TRUE,
           round(data[[nam]]), origin = "1582-10-14"))
       }
     }
+    if (any(isdatetime)) {
+      for (nam in nams[isdatetime]) {
+        data[[nam]] <- as.POSIXct(
+          data[[nam]],
+          origin = "1582-10-14",
+          tz = "GMT")
+      }
+    }
     if (any(istime)) {
-      message("time format found for", nams[istime],
-              "This is a 24 time and no date and thus not converted.")
-      #   for (nam in nams[istime]) {
-      #     data[[nam]] <- as.POSIXlt(data[[nam]], origin="1582-10-14")
-      #   }
+      message(
+        "time format found for:\n",
+        paste(nams[istime], collapse = "\n"),
+        "\ntime variables are not dates and thus not converted."
+      )
     }
 
   }

R/readsav.R

@@ -108,7 +108,7 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
 
   file <- file_ext(basename(filepath))
 
-  if ((tolower(file) != "sav" & tolower(file) != "zsav") &
+  if ((tolower(file) != "sav" && tolower(file) != "zsav") &&
       !isTRUE(override)) {
     warning("Filending is not sav.
              Use Override if this check should be ignored.")
@@ -154,7 +154,7 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
   disppar    <- attribs$disppar
   if (!identical(disppar, integer(0))) {
     disppar    <- t(matrix(disppar, ncol = NCOL(data)))
-  } else{
+  } else {
     disppar <- NULL
   }
   if (NROW(data) == 0)
@@ -229,7 +229,7 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
   varnames <- attribs$varnames
 
   # if autoenc labels were not encoded during readsav() so encode now
-  if (encoding & autoenc) {
+  if (encoding && autoenc) {
 
     # label
     for (i in seq_along(label))
@@ -257,7 +257,7 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
           varunique <- na.omit(unique(data[[varname]]))
         }
 
-        if (isNum & all(is.na(labtable))) {
+        if (isNum && all(is.na(labtable))) {
           nam <- names(labtable)
           labtable <- as.numeric(labtable)
           names(labtable) <- nam
@@ -300,21 +300,30 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
   if (convert.dates) {
 
     nams   <- names(data)
-    isdate <- varmat[, 6] %in% c(20 , 22, 23, 24, 38, 39)
-    istime <- varmat[, 6] %in% c(21, 25)
+    isdate <- varmat[, 6] %in% c(20, 23, 24, 28, 29, 30, 38, 39)
+    isdatetime <- varmat[, 6] %in% c(22, 41)
+    istime <- varmat[, 6] %in% c(21, 25, 40)
 
     if (any(isdate)) {
       for (nam in nams[isdate]) {
         data[[nam]] <- as.Date(as.POSIXct(
           round(data[[nam]]), origin = "1582-10-14"))
       }
     }
+    if (any(isdatetime)) {
+      for (nam in nams[isdatetime]) {
+        data[[nam]] <- as.POSIXct(
+          data[[nam]],
+          origin = "1582-10-14",
+          tz = "GMT")
+      }
+    }
     if (any(istime)) {
-      message("time format found for", nams[istime],
-              "This is a 24 time and no date and thus not converted.")
-    #   for (nam in nams[istime]) {
-    #     data[[nam]] <- as.POSIXlt(data[[nam]], origin="1582-10-14")
-    #   }
+      message(
+        "time format found for:\n",
+        paste(nams[istime], collapse = "\n"),
+        "\ntime variables are not dates and thus not converted."
+      )
     }
 
   }
@@ -380,11 +389,12 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
         if (!is.null(pat)) {
 
           # any variables to combine?
-          if (length(pat) > 1 & grepl("0", pat[2])) {
+          if (length(pat) > 1 && grepl("0", pat[2])) {
             sel <- data[, names(data) %in% pat]
 
             if (all(sapply(sel, is.character))) {
-              pp <- pat[-1]; p1 <- pat[1]
+              pp <- pat[-1]
+              p1 <- pat[1]
 
               remove <- !names(data) %in% pp
 
@@ -413,7 +423,7 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
     names(nams) <- nams
 
     # new_nams <- do.call(rbind, longname)
-    new_nams <- sapply(longname, function(x){
+    new_nams <- sapply(longname, function(x) {
       z <- x[[2]]
       names(z) <- x[[1]]
       z
@@ -455,7 +465,7 @@ read.sav <- function(file, convert.factors = TRUE, generate.factors = TRUE,
 
   longlabel <- attribs$longlabel
 
-  if (convert.factors & !identical(longlabel, list())) {
+  if (convert.factors && !identical(longlabel, list())) {
 
     longlabnames  <- names(longlabel)
 

R/readspss.R

@@ -18,7 +18,7 @@ read.spss <- function(x, ...) {
 
   file <- file_ext(basename(x))
 
-  if (tolower(file) == "sav" | tolower(file) == "zsav") {
+  if (tolower(file) == "sav" || tolower(file) == "zsav") {
     res <- read.sav(x, ...)
   } else if (tolower(file) == "por") {
     res <- read.por(x, ...)

R/tools.R

@@ -7,7 +7,7 @@
 read.encoding <- function(x, fromEncoding, encoding) {
 
   # avoid iconv errors
-  if (!is.na(fromEncoding) & is.na(encoding))
+  if (!is.na(fromEncoding) && is.na(encoding))
     encoding <- fromEncoding
 
   iconv(x,

R/writepor.R

@@ -27,7 +27,7 @@
 #' @export
 write.por <- function(dat, filepath, label, add.rownames = FALSE,
                       convert.factors = TRUE, toEncoding = "CP1252",
-                      convert.dates = TRUE, tz="GMT") {
+                      convert.dates = TRUE, tz = "GMT") {
 
   filepath <- path.expand(filepath)
 
@@ -40,13 +40,13 @@ write.por <- function(dat, filepath, label, add.rownames = FALSE,
     attrlab <- NULL
 
 
-  if (missing(label) & is.null(attrlab))
+  if (missing(label) && is.null(attrlab))
     label <- ""
 
-  if (missing(label) & !is.null(attrlab))
+  if (missing(label) && !is.null(attrlab))
     label <- attrlab
 
-  if (!identical(label, "") & (length(label) != ncol(dat)))
+  if (!identical(label, "") && (length(label) != ncol(dat)))
     stop("label and ncols differ. each col needs a label")
 
   if (any(nchar(label)) > 255)

R/writesav.R

@@ -23,7 +23,7 @@
 #'
 #' @export
 write.sav <- function(dat, filepath, label, add.rownames = FALSE,
-                      compress = FALSE, convert.dates = TRUE, tz="GMT",
+                      compress = FALSE, convert.dates = TRUE, tz = "GMT",
                       debug = FALSE, is_zsav = FALSE, disppar) {
 
   filepath <- path.expand(filepath)
@@ -37,13 +37,13 @@ write.sav <- function(dat, filepath, label, add.rownames = FALSE,
     attrlab <- NULL
 
 
-  if (missing(label) & is.null(attrlab))
+  if (missing(label) && is.null(attrlab))
     label <- ""
 
-  if (missing(label) & !is.null(attrlab))
+  if (missing(label) && !is.null(attrlab))
     label <- attrlab
 
-  if (!identical(label, "") & (length(label) != ncol(dat)))
+  if (!identical(label, "") && (length(label) != ncol(dat)))
     stop("label and ncols differ. each col needs a label")
 
   if (any(nchar(label)) > 255)
@@ -71,7 +71,7 @@ write.sav <- function(dat, filepath, label, add.rownames = FALSE,
 
   LONGVAR <- FALSE
 
-  if (all(nchar(nams) <= 8) & (identical(toupper(nams), nams))) {
+  if (all(nchar(nams) <= 8) && (identical(toupper(nams), nams))) {
     nams <- toupper(nams)
     nvarnames <- substr(nams, 0, 8)
   } else {
@@ -89,7 +89,7 @@ write.sav <- function(dat, filepath, label, add.rownames = FALSE,
     stop("Strings longer than 255 characters not yet implemented")
   }
 
-  vtyp <- ceiling(vtyp / 8) * 8;
+  vtyp <- ceiling(vtyp / 8) * 8
 
   vtyp[vtyp > 255] <- 255
 
@@ -134,14 +134,15 @@ write.sav <- function(dat, filepath, label, add.rownames = FALSE,
   }
 
   longvarnames <- ""
-  if ((length(nvarnames) > length(names(dat))) | LONGVAR)
+  if ((length(nvarnames) > length(names(dat))) || LONGVAR)
     longvarnames <- paste(
       paste0(nvarnames[nvarnames != ""], "=", names(dat)),
       collapse = "\t")
 
   systime <- Sys.time()
   timestamp <- substr(systime, 12, 19)
-  lct <- Sys.getlocale("LC_TIME"); Sys.setlocale("LC_TIME", "C")
+  lct <- Sys.getlocale("LC_TIME")
+  Sys.setlocale("LC_TIME", "C")
   datestamp <- format(Sys.Date(), "%d %b %y")
   Sys.setlocale("LC_TIME", lct)
 
@@ -154,7 +155,7 @@ write.sav <- function(dat, filepath, label, add.rownames = FALSE,
 
   # get vartyp used for display parameters. has to be selected prior to
   # compression. otherwise factor will be wrongfully identified as integer.
-  vartypen <- sapply(dat, function(x)class(x)[[1]])
+  vartypen <- sapply(dat, function(x) class(x)[[1]])
 
   # if compression is selected, try to store numeric, logical and factor as
   # integer and try to compress integer as uint8 (with bias). Since R does

inst/WORDLIST

@@ -0,0 +1,53 @@
+CMD
+CharacterVector
+Codecov
+PSPP
+Rcpp
+TDA
+Ushey
+autoenc
+bool
+cflag
+charactervector
+charcode
+codebase
+datalabel
+dataview
+datestamp
+de
+decrypt
+disppar
+doenc
+dta
+extraproduct
+filelabel
+fromEncoding
+github
+haslabel
+hexcode
+http
+lmissings
+localeToCharset
+longlabel
+longmissing
+longstring
+longstrings
+memisc
+ownEnc
+por
+pspp
+rcpp
+recoded
+repo
+rtools
+sav
+spss
+swapit
+systempath
+tda
+un
+unicode
+varmatrix
+vtype
+www
+zsav