feat: add functiosn to convert multivariate to univariate cfd

Author: Quentin62

NAMESPACE

@@ -16,6 +16,8 @@ export(compute_optimal_encoding)
 export(compute_optimal_encoding_multivariate)
 export(compute_time_spent)
 export(convert2mvcfd)
+export(convertListCfd2Cfd)
+export(convertMvcfd2cfd)
 export(convertToCfd)
 export(cut_data)
 export(estimate_Markov)

R/multivariateFormat.R

@@ -51,3 +51,60 @@ convert2mvcfd <- function(x, stateColumns = NULL) {
   return(distinct(x))
 }
 
+#' Convert a multivariate cfd to an univariate one
+#'
+#' @param x multivariate cfd: data.frame with id, time columns and several stateColumns (output of \code{\link{convert2mvcfd}})
+#' @param sep separator used to concatenate states
+#' @param stateColumns names of the state columns. If NULL, it looks for columns with state in their names
+#'
+#' @return univariate cfd to use in \code{\link{compute_optimal_encoding}}. A data.frame with is, time and state columns
+#'
+#' @examples
+#' set.seed(42)
+#' x1 <- generate_Markov(n = 10, K = 2)
+#' x1 <- cut_data(x1, Tmax = 1)
+#' x2 <- generate_Markov(n = 10, K = 2)
+#' x2 <- cut_data(x2, Tmax = 1)
+#'
+#' x <- list(x1, x2)
+#'
+#' mvcfd <- convert2mvcfd(x)
+#' cfd <- convertMvcfd2cfd(mvcfd)
+#'
+#' @export
+convertMvcfd2cfd <- function(x, sep = "_", stateColumns = NULL) {
+  checkData(x, requiredColNames = c("id", "time"))
+
+  if (is.null(stateColumns)) {
+    stateColumns <- colnames(x)[grep("state", colnames(x))]
+  }
+
+  xCfd <- x[c("id", "time")]
+  xCfd$state <- as.factor(do.call(paste, c(x[stateColumns], sep = sep)))
+
+  return(xCfd)
+}
+
+#' Convert a list of univariate cfds to an unique univariate cfd
+#'
+#' @param x list of cfd
+#' @param sep separator used to concatenate states
+#'
+#' @return univariate cfd to use in \code{\link{compute_optimal_encoding}}. A data.frame with is, time and state columns
+#'
+#' @examples
+#' set.seed(42)
+#' x1 <- generate_Markov(n = 10, K = 2)
+#' x1 <- cut_data(x1, Tmax = 1)
+#' x2 <- generate_Markov(n = 10, K = 2)
+#' x2 <- cut_data(x2, Tmax = 1)
+#'
+#' x <- list(x1, x2)
+#'
+#' cfd <- convertListCfd2Cfd(mvcfd)
+#'
+#' @export
+convertListCfd2Cfd <- function(x, sep = "_") {
+  xMcfd <- convert2mvcfd(x)
+  return(convertMvcfd2cfd(xMcfd, sep = sep))
+}

man/convertListCfd2Cfd.Rd

@@ -71,3 +71,65 @@ test_that("convert2mvcfd works with stateColumns", {
   expect_equal(out, expectedOut)
 })
 
+test_that("convertMvcfd2cfd works", {
+  # 2 columns
+  x <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state1 = c(1, 2, 1), state2 = c(2, 1, 3))
+  expectedOut <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state = as.factor(c("1_2", "2_1", "1_3")))
+
+  out <- convertMvcfd2cfd(x)
+  expect_equal(out, expectedOut)
+
+  # > 2 columns
+  x <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state1 = c(1, 2, 1), state2 = c(2, 1, 3), state3 = c("a", "b", "c"))
+  expectedOut <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state = as.factor(c("1_2_a", "2_1_b", "1_3_c")))
+
+  out <- convertMvcfd2cfd(x)
+  expect_equal(out, expectedOut)
+})
+
+test_that("convertMvcfd2cfd works with custom sep", {
+  x <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state1 = c(1, 2, 1), state2 = c(2, 1, 3))
+  expectedOut <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state = as.factor(c("1 & 2", "2 & 1", "1 & 3")))
+
+  out <- convertMvcfd2cfd(x, sep = " & ")
+  expect_equal(out, expectedOut)
+})
+
+test_that("convertMvcfd2cfd works with custom stateColumns", {
+  x <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state1 = c(1, 2, 1), state2 = c(2, 1, 3))
+  expectedOut <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state = as.factor(c("1 & 2", "2 & 1", "1 & 3")))
+
+  out <- convertMvcfd2cfd(x, sep = " & ")
+  expect_equal(out, expectedOut)
+})
+
+test_that("convertMvcfd2cfd throws error with bad input", {
+  x1 <- data.frame(id1 = c(1, 1, 1), time = c(0, 0.5, 1))
+
+  expect_error(convertMvcfd2cfd(2), regexp = "data must be a data.frame")
+  expect_error(convertMvcfd2cfd(x1), regexp = "Missing columns in data: id.")
+})
+
+test_that("convertListCfd2Cfd works", {
+  x1 <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state = c(1, 2, 1))
+  x2 <- data.frame(id = c(1, 1, 1), time = c(0, 0.25, 0.9), state = c(1, 2, 3))
+  x <- list(x1, x2)
+
+  expectedOut <- data.frame(
+    id = rep(1, 5), time = c(0, 0.25, 0.5, 0.9, 1), state = as.factor(c("1_1", "1_2", "2_2", "2_3", "1_3"))
+  )
+  out <- convertListCfd2Cfd(x)
+  expect_equal(out, expectedOut)
+})
+
+test_that("convertListCfd2Cfd works with custom sep", {
+  x1 <- data.frame(id = c(1, 1, 1), time = c(0, 0.5, 1), state = c(1, 2, 1))
+  x2 <- data.frame(id = c(1, 1, 1), time = c(0, 0.25, 0.9), state = c(1, 2, 3))
+  x <- list(x1, x2)
+
+  expectedOut <- data.frame(
+    id = rep(1, 5), time = c(0, 0.25, 0.5, 0.9, 1), state = as.factor(c("1 & 1", "1 & 2", "2 & 2", "2 & 3", "1 & 3"))
+  )
+  out <- convertListCfd2Cfd(x, sep = " & ")
+  expect_equal(out, expectedOut)
+})