Merge pull request #7 from EuracBiomedicalResearch/jomain

Several smaller fixes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tidyfr
 Title: R Interface for the Textual Dataset Format
-Version: 0.99.17
+Version: 0.99.18
 Description: The tidyfr package provides import and export functionality for the
     Textual Dataset Format (TFD). The package takes care to correctly format the
     various data types, implements solutions for handling of different encodings
@@ -31,4 +31,4 @@ VignetteBuilder: knitr
 BugReports: https://github.com/EuracBiomedicalResearch/tidyfr/issues
 URL: https://github.com/EuracBiomedicalResearch/tidyfr
 Roxygen: list(markdown=TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NAMESPACE

@@ -7,8 +7,8 @@ export(data_module)
 export(data_path)
 export(export_tdf)
 export(format_aid)
+export(group_labels)
 export(groups)
-export(grp_labels)
 export(labels_from_data)
 export(list_data_modules)
 export(mapping_from_data)

NEWS.md

@@ -1,5 +1,11 @@
 # `tidyfr` 0.99
 
+## Changes in 0.99.18
+
+- Rename "grp_labels.txt" to "group_labels.txt".
+- Export an additional file "labels_modules.txt" that links (all) labels to
+  the module.
+
 ## Changes in 0.99.17
 
 - Export also date_first_added and date_last_edited labels (columns need to be

R/data-export.R

@@ -71,7 +71,7 @@
 #'   columns are `"group"` (the name of the group) and `"label"` (the name of
 #'   the column in *data*).
 #'
-#' - **grp_labels**: contains descriptions for the *groups*. Expected columns
+#' - **group_labels**: contains descriptions for the *groups*. Expected columns
 #'   are `"group"` (the name of the group) and `"description"` (the
 #'   name/description of the group).
 #'
@@ -95,7 +95,7 @@
 #'     `data`. Expected columns are `"group"` and `"label"`. See the TDF
 #'     definition for details.
 #'
-#' @param grp_labels `data.frame` with the names (descriptions) of the groups
+#' @param group_labels `data.frame` with the names (descriptions) of the groups
 #'     defined in `groups`.
 #'
 #' @param labels `data.frame` with *annotations* to the variables (labels) in
@@ -160,11 +160,11 @@
 #' ## information
 #' export_tdf(name = "test_data", description = "Simple test data.",
 #'     version = "1.0.0", date = date(), path = path, data = d,
-#'     groups = g, grp_labels = gl, labels = l, mapping = m)
+#'     groups = g, group_labels = gl, labels = l, mapping = m)
 export_tdf <- function(name = character(), description = character(),
                        version = character(), date = character(),
                        path = ".", data = data.frame(), groups = data.frame(),
-                       grp_labels = data.frame(),
+                       group_labels = data.frame(),
                        labels = labels_from_data(data),
                        mapping = mapping_from_data(data), na = -89) {
     if (!length(name))
@@ -194,9 +194,9 @@ export_tdf <- function(name = character(), description = character(),
     if (nrow(groups))
         .valid_groups(groups, stop = TRUE)
     else groups <- .empty_groups()
-    if (nrow(grp_labels))
-        .valid_grp_labels(grp_labels, stop = TRUE)
-    else grp_labels <- .empty_grp_labels()
+    if (nrow(group_labels))
+        .valid_group_labels(group_labels, stop = TRUE)
+    else group_labels <- .empty_group_labels()
     dtypes <- vapply(data, function(z) class(z)[1L], character(1))
     if (nrow(labels)) {
         ## Check if columns min, max and missing are there...
@@ -223,14 +223,15 @@ export_tdf <- function(name = character(), description = character(),
     .valid_data_mapping_category_codes(data, mapping, stop = TRUE)
     .valid_labels_mapping_categories(labels, mapping, stop = TRUE)
     .valid_data_groups(data, groups, stop = TRUE)
-    .valid_groups_grp_labels(groups, grp_labels, stop = TRUE)
+    .valid_groups_group_labels(groups, group_labels, stop = TRUE)
     ## Actual exporting
     .info_skeleton(name = name, description = description,
                    version = version, date = date, path = module_path)
     .export_data(.format_data_export(data, na = na), path = module_path)
     .export_groups(groups, path = module_path)
-    .export_grp_labels(grp_labels, path = module_path)
+    .export_group_labels(group_labels, path = module_path)
     .export_labels(labels, path = module_path)
+    .export_labels_modules(labels, module = name, path = module_path)
     .export_mapping(mapping, path = module_path)
     ## Create a NEWS.md file.
     news_file <- file.path(path, name, "NEWS.md")
@@ -321,7 +322,7 @@ mapping_from_data <- function(data) {
     data.frame(group = character(), label = character())
 }
 
-.empty_grp_labels <- function() {
+.empty_group_labels <- function() {
     data.frame(group = character(), description = character())
 }
 
@@ -344,7 +345,7 @@ mapping_from_data <- function(data) {
                   "date\t", date, "\n",
                   "export_date\t", date(), "\n",
                   "export_info\texported with tidyfr version ",
-                  packageVersion("tidyfr"), "\n")
+                  packageVersion("tidyfr"))
     writeLines(out, con = file.path(path, "info.txt"))
 }
 
@@ -374,12 +375,22 @@ mapping_from_data <- function(data) {
                     file = file.path(path, "labels_additional_info.txt"))
 }
 
+.export_labels_modules <- function(path = ".", labels = data.frame(),
+                                   module = character()) {
+    labels <- .fill_labels(labels)
+    l <- data.frame(label = labels$label, module = rep(module, nrow(labels)))
+    write.table(l, sep = "\t", quote = FALSE, na = "", row.names = FALSE,
+                file = file.path(path, "labels_modules.txt"))
+}
+
+
 .export_groups <- function(path = ".", groups = .empty_groups()) {
     write.table(groups, sep = "\t", quote = FALSE, na = "",
                 row.names = FALSE, file = file.path(path, "groups.txt"))
 }
 
-.export_grp_labels <- function(path = ".", grp_labels = .empty_grp_labels()) {
-    write.table(grp_labels, sep = "\t", quote = FALSE, na = "",
-                row.names = FALSE, file = file.path(path, "grp_labels.txt"))
+.export_group_labels <- function(path = ".",
+                                 group_labels = .empty_group_labels()) {
+    write.table(group_labels, sep = "\t", quote = FALSE, na = "",
+                row.names = FALSE, file = file.path(path, "group_labels.txt"))
 }

R/data-module.R

@@ -41,9 +41,9 @@
 #'   from the data module.
 #'
 #' - `groups`: returns a `data.frame` with the optional grouping of variables.
-#'   The group descriptions are provided byt the `grp_labels` function.
+#'   The group descriptions are provided byt the `group_labels` function.
 #'
-#' - `grp_labels`: returns a `data.frame` with a description for each defined
+#' - `group_labels`: returns a `data.frame` with a description for each defined
 #'   variable group.
 #'
 #' - `labels`: returns a `data.frame` with the description and annotation of the
@@ -134,7 +134,7 @@
 #' groups(mdl)
 #'
 #' ## Get the corresponding group description
-#' grp_labels(mdl)
+#' group_labels(mdl)
 NULL
 
 setClass("DataModule",
@@ -196,9 +196,9 @@ setMethod("show", "DataModule", function(object) {
 #' @rdname DataModule
 #'
 #' @export
-grp_labels <- function(object) {
+group_labels <- function(object) {
     validObject(object)
-    .grp_labels(modulePath(object))
+    .group_labels(modulePath(object))
 }
 
 #' @rdname DataModule
@@ -261,7 +261,7 @@ moduleDate <- function(object) object@date
 .valid_data_directory <- function(path, stop = FALSE, quick = FALSE) {
     fls <- dir(path)
     msgs <- character()
-    if (!all(c("data.txt", "groups.txt", "grp_labels.txt",
+    if (!all(c("data.txt", "groups.txt", "group_labels.txt",
                "info.txt", "labels.txt", "mapping.txt") %in% basename(fls))) {
         msgs <- c(msgs, paste0("Folder ", path, " is missing one or more",
                                " required data files."))
@@ -298,11 +298,11 @@ moduleDate <- function(object) object@date
         if (length(msgs <- .valid_groups(groups, stop = stop))) return(msgs)
         if (length(msgs <- .valid_data_groups(data, groups, stop = stop)))
             return(msgs)
-        grp_labels <- .grp_labels(path)
-        if (length(msgs <- .valid_grp_labels(grp_labels, stop = stop)))
+        group_labels <- .group_labels(path)
+        if (length(msgs <- .valid_group_labels(group_labels, stop = stop)))
             return(msgs)
-        if (length(msgs <- .valid_groups_grp_labels(
-                       groups, grp_labels, stop = stop))) return(msgs)
+        if (length(msgs <- .valid_groups_group_labels(
+                       groups, group_labels, stop = stop))) return(msgs)
     }
     TRUE
 }
@@ -323,8 +323,8 @@ moduleDate <- function(object) object@date
     .read_dataset_file(x, "groups")
 }
 
-.grp_labels <- function(x) {
-    gl <- .read_dataset_file(x, "grp_labels")
+.group_labels <- function(x) {
+    gl <- .read_dataset_file(x, "group_labels")
     rownames(gl) <- gl$group
     gl
 }
@@ -358,7 +358,7 @@ moduleDate <- function(object) object@date
 #'
 #' - `data` has column aid: `.valid_aid`
 #' - `groups` has columns group and label: `.valid_groups`
-#' - `grp_labels` has columns group and description: `.valid_grp_labels`
+#' - `group_labels` has columns group and description: `.valid_group_labels`
 #' - `info` is correct: .valid_info
 #' - `labels` has required columns: `.valid_labels`
 #' - `mapping` has required columns label code and value: `.valid_mapping`.
@@ -374,8 +374,8 @@ moduleDate <- function(object) object@date
 #'   `.valid_labels_mapping_categories`
 #' - `groups` and `data`: groups does not contain labels that are not in data:
 #'   `.valid_data_groups`.
-#' - `groups` and `grp_labels`: have a label for each group:
-#'   `.valid_groups_grp_labels`.
+#' - `groups` and `group_labels`: have a label for each group:
+#'   `.valid_groups_group_labels`.
 #'
 #' @noRd
 NULL
@@ -410,12 +410,12 @@ NULL
     msgs
 }
 
-.valid_grp_labels <- function(x, stop = TRUE) {
+.valid_group_labels <- function(x, stop = TRUE) {
     msgs <- character()
     if (ncol(x) != 2)
-        msgs <- c(msgs, "grp_labels is expected to have two columns.")
+        msgs <- c(msgs, "group_labels is expected to have two columns.")
     if (!length(msgs) && !all(colnames(x) == c("group", "description")))
-        msgs <- c(msgs, "grp_labels is required to have columns named ",
+        msgs <- c(msgs, "group_labels is required to have columns named ",
                   "\"group\" and \"description\".")
     if (stop && length(msgs))
         stop(msgs)
@@ -543,11 +543,12 @@ NULL
     msgs
 }
 
-.valid_groups_grp_labels <- function(groups, grp_labels, stop = TRUE) {
+.valid_groups_group_labels <- function(groups, group_labels, stop = TRUE) {
     msgs <- character()
-    if (length(miss <- groups$group[!groups$group %in% grp_labels$group]))
-        msgs <- c(msgs, paste0("missing group descriptions in grp_labels for: ",
-                               paste0("\"", miss, "\"", collapse = ", ")))
+    if (length(miss <- groups$group[!groups$group %in% group_labels$group]))
+        msgs <- c(
+            msgs, paste0("missing group descriptions in group_labels for: ",
+                         paste0("\"", miss, "\"", collapse = ", ")))
     if (stop && length(msgs))
         stop(msgs)
     msgs