Merge pull request #35 from antaldaniel/master

harmonising with the dataset package

Author: antaldaniel

.github/workflows/rhub.yaml

@@ -0,0 +1,95 @@
+# R-hub's generic GitHub Actions workflow file. It's canonical location is at
+# https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml
+# You can update this file to a newer version using the rhub2 package:
+#
+# rhub::rhub_setup()
+#
+# It is unlikely that you need to modify this file manually.
+
+name: R-hub
+run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}"
+
+on:
+  workflow_dispatch:
+    inputs:
+      config:
+        description: 'A comma separated list of R-hub platforms to use.'
+        type: string
+        default: 'linux,windows,macos'
+      name:
+        description: 'Run name. You can leave this empty now.'
+        type: string
+      id:
+        description: 'Unique ID. You can leave this empty now.'
+        type: string
+
+jobs:
+
+  setup:
+    runs-on: ubuntu-latest
+    outputs:
+      containers: ${{ steps.rhub-setup.outputs.containers }}
+      platforms: ${{ steps.rhub-setup.outputs.platforms }}
+
+    steps:
+    # NO NEED TO CHECKOUT HERE
+    - uses: r-hub/actions/setup@v1
+      with:
+        config: ${{ github.event.inputs.config }}
+      id: rhub-setup
+
+  linux-containers:
+    needs: setup
+    if: ${{ needs.setup.outputs.containers != '[]' }}
+    runs-on: ubuntu-latest
+    name: ${{ matrix.config.label }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config: ${{ fromJson(needs.setup.outputs.containers) }}
+    container:
+      image: ${{ matrix.config.container }}
+
+    steps:
+      - uses: r-hub/actions/checkout@v1
+      - uses: r-hub/actions/platform-info@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/setup-deps@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/run-check@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+
+  other-platforms:
+    needs: setup
+    if: ${{ needs.setup.outputs.platforms != '[]' }}
+    runs-on: ${{ matrix.config.os }}
+    name: ${{ matrix.config.label }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config: ${{ fromJson(needs.setup.outputs.platforms) }}
+
+    steps:
+      - uses: r-hub/actions/checkout@v1
+      - uses: r-hub/actions/setup-r@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}
+      - uses: r-hub/actions/platform-info@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/setup-deps@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}
+      - uses: r-hub/actions/run-check@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}

DESCRIPTION

@@ -29,6 +29,7 @@ Depends:
     R (>= 3.5.0)
 Imports: 
     assertthat,
+    dataset,
     dplyr (>= 1.0.0),
     fs,
     glue,
@@ -56,13 +57,14 @@ Suggests:
     png,
     rmarkdown,
     spelling,
+    statcodelists,
     testthat (>= 3.0.0)
 VignetteBuilder: 
     knitr
 Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 X-schema.org-isPartOf: http://ropengov.org/
 X-schema.org-keywords: ropengov

NAMESPACE

@@ -1,11 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("[",retroharmonize_labelled_spss_survey)
+S3method("names<-",retroharmonize_labelled_spss_survey)
 S3method(format,retroharmonize_labelled_spss_survey)
 S3method(is.na,retroharmonize_labelled_spss_survey)
 S3method(levels,retroharmonize_labelled_spss_survey)
+S3method(mean,retroharmonize_labelled_spss_survey)
+S3method(median,retroharmonize_labelled_spss_survey)
+S3method(obj_print_footer,retroharmonize_labelled_spss_survey)
 S3method(obj_print_header,retroharmonize_labelled_spss_survey)
+S3method(print,survey_df)
 S3method(quantile,retroharmonize_labelled_spss_survey)
+S3method(sum,retroharmonize_labelled_spss_survey)
 S3method(summary,retroharmonize_labelled_spss_survey)
 S3method(summary,survey)
 S3method(vec_cast,character.retroharmonize_labelled_spss_survey)
@@ -17,6 +23,7 @@ S3method(vec_ptype2,retroharmonize_labelled_spss_survey.double)
 S3method(vec_ptype2,retroharmonize_labelled_spss_survey.retroharmonize_labelled_spss_survey)
 S3method(vec_ptype_abbr,retroharmonize_labelled_spss_survey)
 S3method(vec_ptype_full,retroharmonize_labelled_spss_survey)
+S3method(weighted.mean,retroharmonize_labelled_spss_survey)
 export("%>%")
 export(as_character)
 export(as_factor)
@@ -45,6 +52,7 @@ export(is.crosswalk_table)
 export(is.labelled_spss_survey)
 export(is.na_range_to_values)
 export(is.survey)
+export(is.survey_df)
 export(label_normalize)
 export(labelled_spss_survey)
 export(merge_surveys)
@@ -63,11 +71,19 @@ export(subset_save_surveys)
 export(subset_surveys)
 export(subset_waves)
 export(survey)
+export(survey_df)
 export(val_label_normalize)
 export(var_label_normalize)
 import(rlang)
 import(vctrs)
 importFrom(assertthat,assert_that)
+importFrom(dataset,`subject<-`)
+importFrom(dataset,datacite)
+importFrom(dataset,dataset_df)
+importFrom(dataset,dublincore)
+importFrom(dataset,is.dataset_df)
+importFrom(dataset,subject)
+importFrom(dataset,subject_create)
 importFrom(dplyr,across)
 importFrom(dplyr,all_of)
 importFrom(dplyr,any_of)
@@ -111,11 +127,13 @@ importFrom(haven,read_sav)
 importFrom(haven,read_spss)
 importFrom(haven,write_sav)
 importFrom(here,here)
+importFrom(labelled,`var_label<-`)
 importFrom(labelled,labelled)
 importFrom(labelled,labelled_spss)
 importFrom(labelled,na_range)
 importFrom(labelled,na_values)
 importFrom(labelled,to_character)
+importFrom(labelled,to_labelled)
 importFrom(labelled,val_labels)
 importFrom(labelled,var_label)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,5 +1,6 @@
+# retroharmonize 0.2.6
+
 # retroharmonize 0.2.5
-* New article [Creating a Harmonized Cultural Access & Participation Dataset for Music](https://retroharmonize.dataobservatory.eu/articles/cap.html)
 * Unified function interface and parameter names.
 * This development version has a few known [issues](https://github.com/rOpenGov/retroharmonize/issues).
 

R/assertions.R

@@ -1,7 +1,6 @@
 #' @keywords  internal
 validate_survey_list <- function(survey_list) { 
 
-  
   assert_that(!is.null(survey_list), 
               msg = "The parameter 'survey_list' is NULL.")
 
@@ -51,16 +50,16 @@ validate_survey_list <- function(survey_list) {
 
     duplicate_ids <- ids[duplicated (ids )]
     duplicate_filenames <- filenames[duplicated (filenames)]
-    
+
     assert_that(length(duplicate_ids)==0, 
                 msg = paste0(
-                  paste(duplicate_ids), 
+                  paste(duplicate_ids, collapse = ", "), 
                   " are not unique."
                 ))
 
     assert_that(length(duplicate_filenames)==0, 
                 msg = paste0(
-                  paste(duplicate_filenames), 
+                  paste(duplicate_filenames, collapse = ", "), 
                   " are not unique."
                 ))
   }
@@ -81,18 +80,6 @@ validate_survey_files <- function(survey_files) {
   TRUE
 }
 
-#' @importFrom assertthat assert_that
-#' @importFrom fs is_file
-#' @keywords  internal
-valid_file_info <- function(file) {
-  assertthat::assert_that(
-    fs::is_file(file),
-    msg =  paste0("file='", file, "' is not a file. ")
-  )
-  
-  file.info(file)
-}
-
 #' @title Validate harmonize_labels parameter
 #' Check if "from", "to", and "numeric_values" are of equal lengths.
 #' @importFrom dplyr select

R/codebook.R

@@ -9,6 +9,7 @@
 #' # This is a new function candidate and is not written yet.
 #' codebook_create()
 
+#' @keywords internal 
 codebook_create <- function() {
-  NULL
+  cat("Not written yet")
 }

R/harmonize_values.R

@@ -21,7 +21,7 @@
 #' @param id A survey ID, defaults to \code{survey_id}
 #' @param remove Defaults to \code{NULL}.  A character or regex that will be removed from all
 #' old value labels, like \code{"\\("|\\)} for ( and ).
-#' @param perl Use perl-like regex? Defaults to {FALSE}.
+#' @param perl Use perl-like regex? Defaults to \code{FALSE}.
 #' @importFrom labelled to_character labelled na_values val_labels
 #' @importFrom labelled var_label
 #' @importFrom tibble tibble as_tibble

R/labelled_spss_survey.R

@@ -207,6 +207,7 @@ obj_print_header.retroharmonize_labelled_spss_survey <- function(x, ...) {
   invisible(x)
 }
 
+#' @export
 obj_print_footer.retroharmonize_labelled_spss_survey <- function(x, ...) {
   print_attributes(x)
   invisible(x)
@@ -276,16 +277,20 @@ as_factor <- function(x, levels = "default", ordered = FALSE) {
   tmp
 }
 
-#' @export
+#' @rdname labelled_spss_survey
+#' @exportS3Method
 levels.retroharmonize_labelled_spss_survey <- function(x) {
   NULL
 }
 
-`names<-.retroharmonize_labelled_spss_survey` <- function(x, value) {
+#' @rdname labelled_spss_survey
+#' @export
+"names<-.retroharmonize_labelled_spss_survey" <- function(x, value) {
   attr(x, "names") <- value
   x
 }
 
+#' @rdname labelled_spss_survey
 #' @importFrom haven format_tagged_na
 #' @export
 format.retroharmonize_labelled_spss_survey <- function(x, ..., digits = getOption("digits")) {
@@ -345,7 +350,9 @@ vec_convert_na <- function(x) {
            vctrs::vec_data(x))
 }
 
+#' @rdname labelled_spss_survey
 #' @importFrom stats median
+#' @export
 median.retroharmonize_labelled_spss_survey <- function(x, na.rm = TRUE, ...) {
   if (is.character(x)) {
     abort("Can't compute median of labelled_spss_survey<character>")
@@ -354,6 +361,7 @@ median.retroharmonize_labelled_spss_survey <- function(x, na.rm = TRUE, ...) {
   median(vec_convert_na(x), na.rm = TRUE, ...)
 }
 
+#' @rdname labelled_spss_survey
 #' @importFrom stats quantile
 #' @export
 quantile.retroharmonize_labelled_spss_survey <- function(x, probs, ...) {
@@ -363,7 +371,9 @@ quantile.retroharmonize_labelled_spss_survey <- function(x, probs, ...) {
   quantile(vec_convert_na(x), probs, na.rm = TRUE, ...)
 }
 
+#' @rdname labelled_spss_survey
 #' @importFrom stats weighted.mean
+#' @exportS3Method
 weighted.mean.retroharmonize_labelled_spss_survey <- function(x, w, ...) {
   if (is.character(x)) {
     abort("Can't compute median of labelled_spss_survey<character>")
@@ -376,6 +386,8 @@ weighted.mean.retroharmonize_labelled_spss_survey <- function(x, w, ...) {
   weighted.mean(vec_convert_na(x), w, na.rm = TRUE, ...)
 }
 
+#' @rdname labelled_spss_survey
+#' @exportS3Method
 mean.retroharmonize_labelled_spss_survey <- function(x, ...) {
   if (is.character(x)) {
     abort("Can't compute mean of labelled_spss_survey<character>")
@@ -384,7 +396,8 @@ mean.retroharmonize_labelled_spss_survey <- function(x, ...) {
   mean(vec_convert_na(x), ...)
 }
 
-
+#' @rdname labelled_spss_survey
+#' @exportS3Method
 sum.retroharmonize_labelled_spss_survey <- function(x, ...) {
   if (is.character(x)) {
     abort("Can't compute sum of labelled_spss_survey<character>")

R/metadata_create.R

@@ -125,7 +125,8 @@ metadata_survey_create <- function(survey) {
   filename <- attr(survey, "filename")
 
   if (is.null(filename)) filename <- "unknown"
-  id <- attr(survey, "id")
+  
+  id <- ifelse(is.null(attr(survey, "id")), attr(survey, "identifier"), attr(survey, "id"))
   if (is.null(id)) id <- "missing"
 
   if( ncol(survey) == 0) {
@@ -138,7 +139,7 @@ metadata_survey_create <- function(survey) {
 
   class_orig <- vapply( survey, function(x) class(x)[1], character(1))
 
-  metadata <- tibble::tibble (
+  metadata <- tibble (
     filename = filename, 
     id = id,
     var_name_orig = names(survey), 
@@ -249,7 +250,7 @@ metadata_survey_create <- function(survey) {
     select ( -label_type )
 }
 
-
+# -----------------------------------------------------------------------
 #' @title Initialize a metadata data frame
 #'
 #' @inheritParams metadata_create