Create tidy methods

DESCRIPTION

@@ -25,6 +25,7 @@ URL: https://socialcontactdata.github.io/contactmatrix/,
 BugReports: https://github.com/socialcontactdata/contactmatrix/issues
 Imports: 
     cli,
+    generics,
     stats
 Suggests: 
     knitr,

NAMESPACE

@@ -8,6 +8,8 @@ S3method(cm_get_groupings,contactmatrix_list)
 S3method(head,contactmatrix)
 S3method(print,contactmatrix)
 S3method(print,contactmatrix_list)
+S3method(tidy,contactmatrix)
+S3method(tidy,contactmatrix_list)
 export(as_contactmatrix)
 export(assert_contactmatrix)
 export(assert_contactmatrix_list)
@@ -19,6 +21,9 @@ export(new_contactmatrix)
 export(new_contactmatrix_list)
 export(test_contactmatrix)
 export(test_contactmatrix_list)
+export(tidy)
+importFrom(generics,tidy)
 importFrom(stats,aggregate)
+importFrom(stats,reshape)
 importFrom(stats,setNames)
 importFrom(utils,head)

R/S3-contactmatrix.R

@@ -81,3 +81,43 @@
   return(out)
 
 }
+
+#' Convert a `contactmatrix` to a tidy `data.frame`
+#'
+#' @param x A `contactmatrix` object
+#' @param ... Ignored for now
+#'
+#' @importFrom generics tidy
+#' @importFrom stats reshape
+#'
+#' @export
+#'
+#' @examples
+#' cm2d <- new_contactmatrix(
+#'   from  = c("[0,5)", "[5,10)",  "[5,10)"),
+#'   to    = c("[0,5)", "[10,15)", "[15,20)"),
+#'   value = c(0.32   , 0.46   , 0.72   ),
+#'   symmetric = TRUE
+#' )
+#' tidy(cm2d)
+tidy.contactmatrix <- function(x, ...) {
+
+  gpings <- cm_get_groupings(x)
+  if (is.list(gpings)) {
+    stop("Cannot tidy a multi-groupings contact matrix yet", call. = FALSE)
+  }
+
+  out <- reshape(
+    as.data.frame(x),
+    idvar = "age_from",
+    ids = gpings,
+    times = gpings,
+    timevar = "age_to",
+    varying = list(gpings),
+    direction = "long"
+  )
+  rownames(out) <- NULL
+  colnames(out)[2] <- "contact"
+  out[, c(3, 1, 2)]
+
+}

R/S3-contactmatrix_list.R

@@ -83,3 +83,39 @@ cm_get_groupings.contactmatrix_list <- function(x, ...) {
   return(attr(x[[1]], "groupings"))
 
 }
+
+#' Convert a `contactmatrix_list` to a tidy `data.frame`
+#'
+#' @param x A `contactmatrix_list` object
+#' @param ... Ignored for now
+#'
+#' @importFrom generics tidy
+#'
+#' @export
+#'
+#' @examples
+#' cm1 <- new_contactmatrix(
+#'   from  = c("[0,5)", "[5,10)",  "[5,10)"),
+#'   to    = c("[0,5)", "[10,15)", "[15,20)"),
+#'   value = c(0.32   , 0.46   , 0.72   )
+#' )
+#'
+#' cm2 <- new_contactmatrix(
+#'   from  = c("[5,10)",  "[0,5)",   "[5,10)"),
+#'   to    = c("[15,20)", "[10,15)", "[10,15)"),
+#'   value = c(0.27   , 0.09   , 0.32   )
+#' )
+#'
+#' cml <- new_contactmatrix_list(cm1, cm2)
+#'
+#' tidy(cml)
+tidy.contactmatrix_list <- function(x, ...) {
+
+  res <- lapply(seq_along(x), function(i) {
+    out <- tidy(x[[i]])
+    out$index <- i
+    return(out)
+  })
+
+  do.call(rbind.data.frame, res)
+}

R/generics.R

@@ -0,0 +1,3 @@
+#' @importFrom generics tidy
+#' @export
+generics::tidy

inst/WORDLIST

@@ -3,14 +3,13 @@ Codecov
 Data’
 Epiverse
 Lifecycle
+Summarise
 Symmetricity
 Zenodo
-al
 codecov
 conmat
 contactdata
-doi
-et
+ggplot
 gh
 github
 https
@@ -24,9 +23,7 @@ packagename
 repo
 socialmixr
 standardised
-summarise
 svg
 tidyverse
 visualisation
 yaml
-zenodo

tests/testthat/test-S3-contactmatrix.R

@@ -0,0 +1,23 @@
+cm2d <- new_contactmatrix(
+  from  = c("[0,5)", "[5,10)", "[5,10)"),
+  to    = c("[0,5)", "[10,15)", "[15,20)"),
+  value = c(0.32, 0.46, 0.72),
+  symmetric = TRUE
+)
+
+test_that("tidy.contactmatrix()", {
+
+  res <- expect_no_condition(tidy(cm2d))
+
+  expect_equal(
+    dim(res),
+    c(length(cm_get_groupings(cm2d))^2, 3L),
+    ignore_attr = TRUE
+  )
+
+  expect_identical(
+    res$contact,
+    c(cm2d)
+  )
+
+})

tests/testthat/test-S3-contactmatrix_list.R

@@ -0,0 +1,30 @@
+cm1 <- new_contactmatrix(
+  from  = c("[0,5)", "[5,10)", "[5,10)"),
+  to    = c("[0,5)", "[10,15)", "[15,20)"),
+  value = c(0.32, 0.46, 0.72)
+)
+
+cm2 <- new_contactmatrix(
+  from  = c("[5,10)", "[0,5)", "[5,10)"),
+  to    = c("[15,20)", "[10,15)", "[10,15)"),
+  value = c(0.27, 0.09, 0.32)
+)
+
+cml <- new_contactmatrix_list(cm1, cm2)
+
+test_that("tidy.contactmatrix_list()", {
+
+  res <- expect_no_condition(tidy(cml))
+
+  expect_equal(
+    dim(res),
+    c(length(cm_get_groupings(cml))^2 * length(cml), 4),
+    ignore_attr = TRUE
+  )
+
+  expect_identical(
+    res$contact,
+    unlist(lapply(cml, c))
+  )
+
+})

vignettes/design-principles.Rmd

@@ -69,10 +69,10 @@ A list of `contactmatrix` from different settings, or just different runs of the
 - [x] `print()` method for human-readable output:
     - [x] Show levels
 - [x] Summarise a `contactmatrix_list` into a `contactmatrix` (`aggregate.contactmatrix_list()`)
+- [x] `tidy()` method to convert to long format and improves integration with the tidyverse and in particular ggplot2
 
 ### Helpers
 
-- [ ] Helper to convert to long format;
 - [ ] Helper to transform and interpolate between ages in bins of various sizes.
 - [x] Helper to make the contact matrix symmetric (`cm_make_symmetric()`)
 - [ ] Helper to obtain the age bins and breaks (if present) in terms of a vector with min or max ages, but also a text-format for figure labels etc.