fix: spss label variable

jinseob2kim · May 8, 2024 · 3c97c9a · 3c97c9a
1 parent 450c040
commit 3c97c9a
Show file tree

Hide file tree

Showing 5 changed files with 26 additions and 22 deletions.
diff --git a/R/FilePsInput.R b/R/FilePsInput.R
@@ -486,10 +486,13 @@ FilePs <- function(input, output, session, nfactor.limit = 20) {
       }
     }
 
-    for (vn in ref[["name.new"]]) {
-      w <- which(ref[["name.new"]] == vn)
-      out.label[variable == vn, var_label := ref[["name.old"]][w]]
+    if (tools::file_ext(input$file$name) != "sav") {
+      for (vn in ref[["name.new"]]) {
+        w <- which(ref[["name.new"]] == vn)
+        out.label[variable == vn, var_label := ref[["name.old"]][w]]
+      }
     }
+
     out.label <- rbind(out.label, data.table(variable = "pscore", class = "numeric", level = NA, var_label = "pscore", val_label = NA))
 
     return(list(data = out, label = out.label, data_varStruct = list(variable = names(out)), except_vars = data.info()$except_vars))

diff --git a/R/FileRepeatedInput.R b/R/FileRepeatedInput.R
@@ -427,9 +427,11 @@ FileRepeated <- function(input, output, session, nfactor.limit = 20) {
       }
     }
 
-    for (vn in ref[["name.new"]]) {
-      w <- which(ref[["name.new"]] == vn)
-      out.label[variable == vn, var_label := ref[["name.old"]][w]]
+    if (tools::file_ext(input$file$name) != "sav") {
+      for (vn in ref[["name.new"]]) {
+        w <- which(ref[["name.new"]] == vn)
+        out.label[variable == vn, var_label := ref[["name.old"]][w]]
+      }
     }
 
     return(list(data = out, label = out.label, naomit = data()$naomit, id.gee = input$repeated_vname))

diff --git a/R/FileSurveyInput.R b/R/FileSurveyInput.R
@@ -502,9 +502,11 @@ FileSurvey <- function(input, output, session, nfactor.limit = 20) {
       }
     }
 
-    for (vn in ref[["name.new"]]) {
-      w <- which(ref[["name.new"]] == vn)
-      out.label[variable == vn, var_label := ref[["name.old"]][w]]
+    if (tools::file_ext(input$file$name) != "sav") {
+      for (vn in ref[["name.new"]]) {
+        w <- which(ref[["name.new"]] == vn)
+        out.label[variable == vn, var_label := ref[["name.old"]][w]]
+      }
     }
 
 

diff --git a/R/csvFileInput.R b/R/csvFileInput.R
@@ -471,11 +471,14 @@ csvFile <- function(input, output, session, nfactor.limit = 20) {
       }
     }
 
-    for (vn in ref[["name.new"]]) {
-      w <- which(ref[["name.new"]] == vn)
-      out.label[variable == vn, var_label := ref[["name.old"]][w]]
+    if (tools::file_ext(input$file$name) != "sav") {
+      for (vn in ref[["name.new"]]) {
+        w <- which(ref[["name.new"]] == vn)
+        out.label[variable == vn, var_label := ref[["name.old"]][w]]
+      }
     }
 
+
     return(list(
       data = out,
       label = out.label,

diff --git a/R/utils.R b/R/utils.R
@@ -7,20 +7,14 @@
 #' @importFrom DT  %>%
 mk.lev2 <- function(out.old, out.label) {
   . <- variable <- val_label <- level <- NULL
-  label.value <- sapply(out.old, function(x) attr(x, "labels")) %>%
-    .[!sapply(., is.null)] %>%
-    sapply(function(x) {
-      dd <- names(x)
-      names(dd) <- x
-      return(dd)
-    })
+  label.value <- sapply(out.old, function(x) attr(x, "labels")) %>% .[!sapply(., is.null)] %>% sapply(function(x){dd <- names(x);names(dd) <- x;return(dd)})
   label.variable <- sapply(out.old, function(x) attr(x, "label")) %>% .[!sapply(., is.null)]
 
-  for (v in names(label.variable)) {
+  for (v in names(label.variable)){
     out.label[variable == v, var_label := label.variable[v]]
   }
-  for (v in names(label.value)) {
-    if (is.factor(out.old[[v]])) {
+  for (v in names(label.value)){
+    if (any(out.label[variable == v, class] != "numeric")){
       out.label[variable == v, val_label := label.value[[v]][level]]
     }
   }