Skip to content

Commit

Permalink
Smaller fixes and updates
Browse files Browse the repository at this point in the history
- Avoid two new lines at the end in info.txt
- Rename grp_labels.txt to group_labels.txt
- Export a labels_modules.txt file
  • Loading branch information
jorainer committed Feb 26, 2024
1 parent 0cc1b1a commit d74a058
Show file tree
Hide file tree
Showing 14 changed files with 102 additions and 73 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
6 changes: 6 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
39 changes: 25 additions & 14 deletions R/data-export.R
Original file line number Diff line number Diff line change
Expand Up @@ -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).
#'
Expand All @@ -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
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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...
Expand All @@ -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")
Expand Down Expand Up @@ -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())
}

Expand All @@ -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"))
}

Expand Down Expand Up @@ -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"))
}
45 changes: 23 additions & 22 deletions R/data-module.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -134,7 +134,7 @@
#' groups(mdl)
#'
#' ## Get the corresponding group description
#' grp_labels(mdl)
#' group_labels(mdl)
NULL

setClass("DataModule",
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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."))
Expand Down Expand Up @@ -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
}
Expand All @@ -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
}
Expand Down Expand Up @@ -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`.
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions man/DataModule.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

8 changes: 4 additions & 4 deletions man/export_tdf.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

25 changes: 18 additions & 7 deletions tests/testthat/test_data-export.R
Original file line number Diff line number Diff line change
Expand Up @@ -100,23 +100,23 @@ test_that(".export_groups works", {
expect_equal(res$label, 1:4)
})

test_that(".empty_grp_labels works", {
res <- .empty_grp_labels()
test_that(".empty_group_labels works", {
res <- .empty_group_labels()
expect_true(is.data.frame(res))
expect_equal(colnames(res), c("group", "description"))
})

test_that(".export_grp_labels works", {
test_that(".export_group_labels works", {
fl <- tempdir()
.export_grp_labels(fl)
res <- read.table(file.path(fl, "grp_labels.txt"),
.export_group_labels(fl)
res <- read.table(file.path(fl, "group_labels.txt"),
sep = "\t", header = TRUE)
expect_equal(colnames(res), c("group", "description"))
expect_true(nrow(res) == 0)

df <- data.frame(group = "a", description = 1:10)
.export_grp_labels(fl, df)
res <- read.table(file.path(fl, "grp_labels.txt"),
.export_group_labels(fl, df)
res <- read.table(file.path(fl, "group_labels.txt"),
sep = "\t", header = TRUE)
expect_equal(colnames(res), c("group", "description"))
expect_true(all(res$group == "a"))
Expand Down Expand Up @@ -210,3 +210,14 @@ test_that("mapping_from_data works", {
expect_equal(colnames(res), c("label", "code", "value"))
expect_true(nrow(res) == 0)
})

test_that(".export_labels_modules works", {
td <- tempdir()
l <- data.frame(label = 1:10, other = "a")
.export_labels_modules(l, module = "well", path = td)
res <- read.table(file.path(td, "labels_modules.txt"), sep = "\t",
header = TRUE)
expect_equal(colnames(res), c("label", "module"))
expect_equal(res$label, 1:10)
expect_equal(res$module, rep("well", 10))
})
Loading

0 comments on commit d74a058

Please sign in to comment.