From 0993a607fa44a6e497e2c3abfbb8a263a9d51bd1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Adrian=20Du=C8=99a?= <dusa.adrian@gmail.com>
Date: Sun, 26 Nov 2023 13:34:09 +0200
Subject: [PATCH] all values NA

---
 R/onLoad.R  |   2 -
 R/print.R   |   2 +-
 R/w_table.R | 108 ++++++++++++++++++++++++++++++----------------------
 3 files changed, 63 insertions(+), 49 deletions(-)

diff --git a/R/onLoad.R b/R/onLoad.R
index 6ece98e..ef06327 100644
--- a/R/onLoad.R
+++ b/R/onLoad.R
@@ -150,8 +150,6 @@
             stringsAsFactors = FALSE,
             factor.exclude = TRUE
         ) {
-
-
             match.names <- function (clabs, nmi) {
                 if (identical (clabs, nmi)) NULL
                 else if (
diff --git a/R/print.R b/R/print.R
index 9de012b..5165dab 100644
--- a/R/print.R
+++ b/R/print.R
@@ -106,7 +106,7 @@
     tick <- c ("\u00b4", "\u0060", "\u2018", "\u2019") # ticks and single quotes
     tick <- c (paste0 (achar, "'"), paste0 (achar, tick), tick)
 
-    if (x[1] != as.matrix(toprint)[1]) {
+    if (!all(is.na(x)) && x[1] != as.matrix(toprint)[1]) {
         # this means the original table was altered. e.g. proportions (tbl)
         class (x) <- setdiff (class (x), c ("w_table", "array"))
         names (dimnames (x)) <- NULL
diff --git a/R/w_table.R b/R/w_table.R
index 8eaac0c..32c0b52 100644
--- a/R/w_table.R
+++ b/R/w_table.R
@@ -203,38 +203,44 @@
     if (!crosstab) {
         valid <- isTRUE (valid) && any (is.na (x))
     }
-
+    
     xlabel <- attr (x, "label", exact = TRUE)
+    allnax <- all (is.na (x))
 
     if (inherits (x, "declared")) {
-        # names_values () arranges missing values at the end
-        xvallab <- names_values (
-            x,
-            drop_na = isTRUE (valid) & crosstab,
-            observed = observed
-        )
-        xna_values <- attr (xvallab, "missing")
-        # x <- factor (as.character (x), levels = names (xvallab))
-        # sometimes (e.g. ISCO codifications in ESS) there are identical labels
-        # with different values, and factor () complains with overlapping levels
-
-        xvalues <- !identical (names (xvallab), as.character (xvallab))
-        # print (head(paste (as.character (x), undeclare (x), sep = "_-_")))
-
-        x <- factor (
-            paste (
-                as.character (undeclare (x)),
-                undeclare (x, drop = TRUE),
-                sep = "_-_"
-            ),
-            levels = paste (names (xvallab), xvallab, sep = "_-_")
-        )
+        allnax <- all (is.empty (x))
+        if (!allnax) {
+            # names_values () arranges missing values at the end
+            xvallab <- names_values (
+                x,
+                drop_na = isTRUE (valid) & crosstab,
+                observed = observed
+            )
+
+            xna_values <- attr (xvallab, "missing")
+            # x <- factor (as.character (x), levels = names (xvallab))
+            # sometimes (e.g. ISCO codifications in ESS) there are identical labels
+            # with different values, and factor () complains with overlapping levels
+
+            xvalues <- !identical (names (xvallab), as.character (xvallab))
+            # print (head(paste (as.character (x), undeclare (x), sep = "_-_")))
+            x <- factor (
+                paste (
+                    as.character (undeclare (x)),
+                    undeclare (x, drop = TRUE),
+                    sep = "_-_"
+                ),
+                levels = paste (names (xvallab), xvallab, sep = "_-_")
+            )
+        }
     }
     else {
         xvalues <- FALSE
-        lvls <- levels (as.factor (x))
-        xvallab <- seq (length (lvls))
-        names (xvallab) <- lvls
+        if (!allnax) {
+            lvls <- levels (as.factor (x))
+            xvallab <- seq (length (lvls))
+            names (xvallab) <- lvls
+        }
     }
 
     xy <- list (x = x)
@@ -248,6 +254,7 @@
         }
 
         ylabel <- attr (y, "label", exact = TRUE)
+        allnay <- all (is.na (y))
 
         nmy <- getName_ (funargs$y)
 
@@ -266,26 +273,32 @@
         }
 
         if (inherits (y, "declared")) {
-            yvallab <- names_values (
-                y,
-                drop_na = crosstab && isTRUE (valid),
-                observed = observed
-            )
-            yna_values <- attr (yvallab, "missing")
-            y <- factor (
-                paste (
-                    as.character (undeclare (y)),
-                    undeclare (y, drop = TRUE),
-                    sep = "_-_"
-                ),
-                levels = paste (names (yvallab), yvallab, sep = "_-_")
-            )
+            allnay <- all (is.empty (y))
+            if (!allnay) {
+                yvallab <- names_values (
+                    y,
+                    drop_na = crosstab && isTRUE (valid),
+                    observed = observed
+                )
+                yna_values <- attr (yvallab, "missing")            
+
+                y <- factor (
+                    paste (
+                        as.character (undeclare (y)),
+                        undeclare (y, drop = TRUE),
+                        sep = "_-_"
+                    ),
+                    levels = paste (names (yvallab), yvallab, sep = "_-_")
+                )
+            }
         }
         else {
             yvalues <- FALSE
-            lvls <- levels (as.factor (y))
-            yvallab <- seq (length (lvls))
-            names (yvallab) <- lvls
+            if (!allnay) {
+                lvls <- levels (as.factor (y))
+                yvallab <- seq (length (lvls))
+                names (yvallab) <- lvls
+            }
         }
 
         xy$y <- y
@@ -372,8 +385,11 @@
         # class (toprint) <- c ("w_table", "matrix")
     }
     else {
-        labels <- rownames (tbl)
-        labels <- unlist (lapply (strsplit (labels, split = "_-_"), "[[", 1))
+        labels <- NULL
+        if (nrow(tbl) > 0) {
+            labels <- rownames (tbl)
+            labels <- unlist (lapply (strsplit (labels, split = "_-_"), "[[", 1))
+        }
 
         if (any (is.na (x))) {
             tbl <- c (tbl, sum (is.na (x)))
@@ -388,7 +404,7 @@
 
         toprint$rel <- proportions (toprint$fre)
         toprint$per <- toprint$rel * 100
-
+        
         if (valid & (length (missing) > 0 | any (is.na (labels)))) {
             vld <- toprint$fre
             nalabels <- is.element (xvallab, xna_values)