Merge pull request #28 from jhk0530/master

SPSS labeled data handling

.Rbuildignore

@@ -11,3 +11,4 @@
 ^\.github$
 ^CRAN-SUBMISSION$
 ^cla$
+^pkgdown$

DESCRIPTION

@@ -1,26 +1,60 @@
 Package: jsmodule
 Title: 'RStudio' Addins and 'Shiny' Modules for Medical Research
-Version: 1.5.3
-Date: 2024-04-15
-Authors@R: c(person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"),  comment = c(ORCID = "0000-0002-9403-605X")),
-             person("Zarathu", role = c("cph", "fnd")),
-             person("Hyunki", "Lee", email = "leevenstar@snu.ac.kr", role = c("aut")),
-             person("Changwoo", "Lim", email = "limcw@zarathu.com", role = c("aut")),
-             person("Jinhwan", "Kim", email = "jinhwan@zarathu.com", role = c("aut")),
-             person("Yoonkyoung", "Jeon", email = "rachel200357@gmail.com", role = c("aut")),
-             person("Jaewoong", "Heo", email = "koolerjaebee@gmail.com", role = c("aut"))
-             )
+Version: 1.5.4
+Date: 2024-05-06
+Authors@R: c(
+  person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"),  comment = c(ORCID = "0000-0002-9403-605X")),
+  person("Zarathu", role = c("cph", "fnd")),
+  person("Hyunki", "Lee", email = "leevenstar@snu.ac.kr", role = c("aut")),
+  person("Changwoo", "Lim", email = "limcw@zarathu.com", role = c("aut")),
+  person("Jinhwan", "Kim", email = "jinhwan@zarathu.com", role = c("aut"), comment = c(ORCID = "0009-0009-3217-2417")),
+  person("Yoonkyoung", "Jeon", email = "rachel200357@gmail.com", role = c("aut")),
+  person("Jaewoong", "Heo", email = "koolerjaebee@gmail.com", role = c("aut")))
 Description: 'RStudio' addins and 'Shiny' modules for descriptive statistics, regression and survival analysis.
 Depends: R (>= 3.4.0)
 License: Apache License 2.0 
 Encoding: UTF-8
 RoxygenNote: 7.3.1
-Imports: utils, stats, data.table, shiny, readxl, DT, jstable, labelled, methods, GGally, ggplot2, haven, rstudioapi, shinycustomloader, MatchIt(>= 3.0.0), survey, jskm(>= 0.4.4), survival, purrr, geepack, maxstat, survIDINRI, timeROC, shinyWidgets, pROC, Hmisc, see, readr, RColorBrewer, ggpubr, officer, rvg, epiDisplay, forestploter, scales
+Imports: 
+  data.table, 
+  DT, 
+  epiDisplay, 
+  forestploter, 
+  geepack, 
+  GGally, 
+  ggplot2, 
+  ggpubr, 
+  haven, Hmisc, 
+  jskm(>= 0.4.4), 
+  jstable, 
+  labelled, 
+  MatchIt(>= 3.0.0),
+  maxstat, 
+  methods, 
+  officer, 
+  pROC, 
+  purrr, 
+  RColorBrewer, 
+  readr, 
+  readxl, 
+  rstudioapi, 
+  rvg, 
+  scales,
+  see, 
+  shiny, 
+  shinycustomloader, 
+  shinyWidgets, 
+  stats, 
+  survey, 
+  survIDINRI, 
+  survival, 
+  timeROC, 
+  utils
 URL: https://jinseob2kim.github.io/jsmodule/, https://github.com/jinseob2kim/jsmodule
 BugReports: https://github.com/jinseob2kim/jsmodule/issues
 Suggests: 
-    testthat,
-    shinytest,
-    knitr,
-    rmarkdown
+  testthat,
+  shinytest,
+  knitr,
+  rmarkdown
 VignetteBuilder: knitr

NEWS.md

@@ -1,37 +1,44 @@
 # jsmodule 1.5.3
 
-## Bugfix: dropdown button & p value options: barplot, boxplot and lineplot
+## Bugfix: 
+- dropdown button & p value options: barplot, boxplot and lineplot
 
 # jsmodule 1.5.2
 
-## Update: Add P value option to barplot, boxplot and lineplot
-## Update: Add dropdown button for graphical option to barplot, boxplot and lineplot
+## Update: 
+- Add P value option to barplot, boxplot and lineplot
+- Add dropdown button for graphical option to barplot, boxplot and lineplot
 
 # jsmodule 1.5.1
 
-## Update: Add Subgroupanalysis to jsBasicGadget
-## Update: Add figure in subgroup analysis with forestplot
-## Update: Add family 'poisson' in forestglm
-## Update: Add "line size" "point size" to lineplot
+## Update: 
+- Add Subgroupanalysis to jsBasicGadget
+- Add figure in subgroup analysis with forestplot
+- Add family 'poisson' in forestglm
+- Add "line size" "point size" to lineplot
 
 # jsmodule 1.5.0
 
-## New module: Subgroup analysis with forestplot (Thanks for [Yoonkyoung Jeon](https://github.com/cyk0315))
+## New module: 
+- Subgroup analysis with forestplot (Thanks for [Yoonkyoung Jeon](https://github.com/cyk0315))
 
 * forestcox (`forestcoxUI`, `forestcoxServer`)
 * forestglm (`forestglmUI`, `forestglmServer`)
 
 # jsmodule 1.4.4
 
-## Update: Add "reverse y-axis" option to lineplot
+## Update: 
+- Add "reverse y-axis" option to lineplot
 
 # jsmodule 1.4.3
 
-## Update `rocModule`: Add accucary/ppv/npv with threshold
+## Update 
+- `rocModule`: Add accucary/ppv/npv with threshold
 
 # jsmodule 1.4.2
 
-## Update: Change default non-normal 2 group comparison test to `wilcox.test`
+## Update: 
+- Change default non-normal 2 group comparison test to `wilcox.test`
 
 # jsmodule 1.4.1
 
@@ -91,14 +98,12 @@
 
 * Add **"Show 1-specificity"** option
 
-
 # jsmodule 1.3.3
 
 ## New module (Thanks for [Changwoo Lim](https://github.com/leevenstar))
 
 * Histogram(`histogramUI`, `histogramServer`)
 
-
 # jsmodule 1.3.2
 
 ## Update 
@@ -115,14 +120,12 @@
 
 * Fix cutoff label of Kaplan-meier plot when continuous independent variable
 
-
 # jsmodule 1.3.0
 
 ## New module (Thanks for [Hyunki Lee](https://github.com/leevenstar))
 
 * Boxplot(`boxUI`, `boxServer`), Lineplot(`LineUI`, `LineServer`), Barplot(`BarUI`, `BarServer`)
 
-
 # jsmodule 1.2.0
 
 ## Update

R/FilePsInput.R

@@ -401,6 +401,10 @@ FilePs <- function(input, output, session, nfactor.limit = 20) {
     ref <- data.info()$ref
     out.label <- mk.lev(out)
 
+    if (tools::file_ext(input$file$name) == "sav") {
+      out.label <- mk.lev2(data()$data.old, out.label)
+    }
+
     if (!is.null(input$check_binary)) {
       if (input$check_binary) {
         validate(

R/FileRepeatedInput.R

@@ -345,6 +345,9 @@ FileRepeated <- function(input, output, session, nfactor.limit = 20) {
     ref <- data()$ref
     out.label <- mk.lev(out)
 
+    if (tools::file_ext(input$file$name) == "sav") {
+      out.label <- mk.lev2(data()$data.old, out.label)
+    }
 
     if (!is.null(input$check_binary)) {
       if (input$check_binary) {

R/FileSurveyInput.R

@@ -410,6 +410,9 @@ FileSurvey <- function(input, output, session, nfactor.limit = 20) {
     out.label <- mk.lev(out)
     # out.label[, var_label := ref[out.label$variable, name.old]]
 
+    if (tools::file_ext(input$file$name) == "sav") {
+      out.label <- mk.lev2(data()$data.old, out.label)
+    }
 
     if (!is.null(input$check_binary) & input$check_binary) {
       validate(

R/csvFileInput.R

@@ -190,7 +190,6 @@ csvFile <- function(input, output, session, nfactor.limit = 20) {
     name.new <- names(out)
     ref <- list(name.old = name.old, name.new = name.new)
 
-
     numstart.vnum <- suppressWarnings(sapply(names(out), function(x) {
       !is.na(as.numeric(substr(x, 1, 1)))
     }))
@@ -201,14 +200,20 @@ csvFile <- function(input, output, session, nfactor.limit = 20) {
       out[, (factor_vars) := lapply(.SD, as.factor), .SDcols = factor_vars]
     }
     conti_vars <- setdiff(names(out), factor_vars)
+
+    # all category variables
     nclass <- unlist(out[, lapply(.SD, function(x) {
       length(unique(x)[!is.na(unique(x))])
     }), .SDcols = conti_vars])
+
     # except_vars <- names(nclass)[ nclass== 1 | nclass >= 10]
+    # Default selected category variables
     add_vars <- names(nclass)[nclass >= 2 & nclass <= 5]
+
     # factor_vars_ini <- union(factor_vars, add_vars)
     return(list(
       data = out,
+      data.old = out.old,
       factor_original = factor_vars,
       conti_original = conti_vars,
       factor_adds_list = names(nclass)[nclass <= nfactor.limit],
@@ -371,16 +376,23 @@ csvFile <- function(input, output, session, nfactor.limit = 20) {
 
   outdata <- reactive({
     out <- data()$data
+
     out[, (data()$conti_original) := lapply(.SD, function(x) {
       as.numeric(as.vector(x))
     }), .SDcols = data()$conti_original]
+
     if (length(input$factor_vname) > 0) {
       out[, (input$factor_vname) := lapply(.SD, as.factor), .SDcols = input$factor_vname]
     }
 
     ref <- data()$ref
+
     out.label <- mk.lev(out)
 
+    if (tools::file_ext(input$file$name) == "sav") {
+      out.label <- mk.lev2(data()$data.old, out.label)
+    }
+
     if (!is.null(input$check_binary)) {
       if (input$check_binary) {
         validate(