bug fixing for grouped plots; fixed tidyselect expressions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggseqplot
 Title: Render Sequence Plots using 'ggplot2'
-Version: 0.8.4
+Version: 0.8.5
 Authors@R: 
   person("Marcel", "Raab", , "marcel.raab@gmail.com", role = c("aut", "cre"),
          comment = c(ORCID = "0000-0002-3097-1591"))
@@ -20,7 +20,7 @@ Depends:
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 RdMacros: Rdpack
 Imports: 
     cli,

NEWS.md

@@ -1,3 +1,9 @@
+# ggseqplot 0.8.5
+
+* fixed #5: if group vector is numeric, grouped plots are now sorted by number instead of order of appearance
+* `.data` in `{tidyselect}` expressions was deprecated in `{tidyselect}` 1.2.0; update takes care of this change
+* fixed incorrect group handling in `ggseqfplot` (issue Reported by Gilbert Ritschard)
+
 # ggseqplot 0.8.4
 
 * fixed #3: haven_labelled group vars are converted into factors before plotting

R/ggseqdplot.R

@@ -155,7 +155,7 @@ ggseqdplot <- function(seqdata,
     group <- forcats::fct_drop(group)
     grinorder <- levels(group)
   } else {
-    grinorder <- factor(unique(group))
+    grinorder <- factor(sort(unique(group)))
   }
 
   statefreqs <- purrr::map(
@@ -221,7 +221,7 @@ ggseqdplot <- function(seqdata,
         names_transform = list(k = as.integer)
       ) |>
       dplyr::mutate(k = factor(.data$k, labels = colnames(statefreqs)[-(1:2)])) |>
-      dplyr::mutate(x = factor(as.integer(.data$k)), .after = .data$k) |>
+      dplyr::mutate(x = factor(as.integer(.data$k)), .after = "k") |>
       dplyr::full_join(grouplabspec)
   )
 

R/ggseqeplot.R

@@ -127,8 +127,8 @@ ggseqeplot <- function(seqdata,
   ) |>
     dplyr::bind_rows() |>
     dplyr::mutate(k = factor(.data$k, levels = unique(.data$k))) |>
-    dplyr::mutate(x = factor(as.integer(.data$k)), .after = .data$k) |>
-    dplyr::rename(entropy = .data$value) |>
+    dplyr::mutate(x = factor(as.integer(.data$k)), .after = "k") |>
+    dplyr::rename(entropy = "value") |>
     dplyr::mutate(group = as.factor(group))
 
 

R/ggseqfplot.R

@@ -127,7 +127,10 @@ ggseqfplot <- function(seqdata,
                                   weighted = weighted,
                                   idxs = ranks))
 
-  group <- rep(grinorder, each = max(ranks))
+  gr_length <- purrr::map(fplotdata, nrow) |>
+    unlist()
+
+  group <- rep(grinorder, gr_length)
 
   coverage <- purrr::map(fplotdata,
                          ~attributes(.x)$freq$Percent) |>

R/ggseqiplot.R

@@ -152,7 +152,7 @@ ggseqiplot <- function(seqdata,
     group <- forcats::fct_drop(group)
     grinorder <- levels(group)
   } else {
-    grinorder <- factor(unique(group))
+    grinorder <- factor(sort(unique(group)))
   }
   if (is.null(group)) grinorder <- factor(1)
 
@@ -198,7 +198,7 @@ ggseqiplot <- function(seqdata,
   suppressMessages(
     spelldata <- TraMineR::seqformat(seqdata, to = "SPELL") |>
       dplyr::full_join(auxid, by = dplyr::join_by("id")) |>
-      dplyr::select(.data$idnew, dplyr::everything()) |>
+      dplyr::select("idnew", dplyr::everything()) |>
       dplyr::mutate(
         states = factor(.data$states,
                         levels = TraMineR::alphabet(seqdata),
@@ -212,20 +212,20 @@ ggseqiplot <- function(seqdata,
       dplyr::group_by(.data$idnew) |>
       dplyr::mutate(spell = dplyr::row_number(), .after = 1) |>
       dplyr::as_tibble() |>
-      dplyr::rename(left = .data$begin, right = .data$end)
+      dplyr::rename(left = "begin", right = "end")
   )
 
 
   suppressMessages(
     dt <- spelldata |>
       dplyr::arrange(sortv) |>
-      dplyr::select(.data$idnew, .data$weight, group) |>
+      dplyr::select("idnew", "weight", group) |>
       dplyr::distinct(.data$idnew, .keep_all = TRUE) |>
       dplyr::ungroup() |>
       dplyr::group_by(group) |>
       dplyr::mutate(begin = 0, end = cumsum(.data$weight)) |>
       dplyr::ungroup() |>
-      dplyr::select(-.data$weight, -.data$group) |>
+      dplyr::select(-"weight", -"group") |>
       dplyr::full_join(spelldata, by = "idnew")
   )
 
@@ -407,14 +407,14 @@ ggseqiplot <- function(seqdata,
       aux = ifelse(.data$aux == 0, 1, .data$aux)
     ) |>
     tidyr::uncount(.data$aux) |>
-    dplyr::select(-.data$aux) |>
+    dplyr::select(-"aux") |> #.data$aux
     dplyr::group_by(.data$idnew) |>
     dplyr::mutate(
       left = dplyr::row_number() - 1,
       right = ifelse(.data$aux2 == 0, .data$left, .data$left + 1)
     ) |>
     dplyr::ungroup() |>
-    dplyr::select(-.data$aux2)
+    dplyr::select(-"aux2")
 
 
   dt2 <- dt2 |>

R/ggseqmsplot.R

@@ -90,7 +90,7 @@ ggseqmsplot <- function(seqdata,
     group <- forcats::fct_drop(group)
     grinorder <- levels(group)
   } else {
-    grinorder <- factor(unique(group))
+    grinorder <- factor(sort(unique(group)))
   }
   if (is.null(group)) grinorder <- factor(1)
 

R/ggseqmtplot.R

@@ -116,7 +116,7 @@ ggseqmtplot <- function(seqdata,
     group <- forcats::fct_drop(group)
     grinorder <- levels(group)
   } else {
-    grinorder <- factor(unique(group))
+    grinorder <- factor(sort(unique(group)))
   }
 
   xandgrouplabs <- xandgrouplab(seqdata = seqdata,

R/ggseqrfplot.R

@@ -335,7 +335,7 @@ provide a dissimilarity matrix ('diss')"
   dotdata <- purrr::imap(seqrfobject$rf$dist.list,
                          ~dplyr::tibble(k = .y, values = .x)) |>
     dplyr::bind_rows() |>
-    dplyr::left_join(dplyr::select(boxdata, .data$k, .data$ymin, .data$ymax), by = "k") |>
+    dplyr::left_join(dplyr::select(boxdata, "k", "ymin", "ymax"), by = "k") |>
     dplyr::filter(.data$values < .data$ymin | .data$values > .data$ymax)
 
 
@@ -350,8 +350,8 @@ provide a dissimilarity matrix ('diss')"
     dplyr::group_by(.data$k) |>
     dplyr::summarise(ymin = min(.data$aux_min),
                      ymax = max(.data$aux_max)) |>
-    dplyr::left_join(dplyr::select(boxdata, -c(.data$ymin,.data$ymax)), by = "k") |>
-    dplyr::relocate(.data$ymax, .after = .data$upper)
+    dplyr::left_join(dplyr::select(boxdata, -c("ymin","ymax")), by = "k") |>
+    dplyr::relocate("ymax", .after = "upper")
 
 
   p2 <- ggplot() +

R/ggseqrplot.R

@@ -157,7 +157,7 @@ ggseqrplot <- function(seqdata,
                               `Mean dist. to representative seq.` = .data$MD
                             ) |>
                             dplyr::filter(.data$id != max(.data$id)) |>
-                            tidyr::pivot_longer(cols = -.data$id))
+                            tidyr::pivot_longer(cols = -"id"))
 
 
   rplotdata <- purrr::imap(sort(unique(group)),

R/ggseqtrplot.R

@@ -101,12 +101,46 @@ ggseqtrplot <- function(seqdata,
     group <- forcats::fct_drop(group)
     grinorder <- levels(group)
   } else {
-    grinorder <- factor(unique(group))
+    grinorder <- factor(sort(unique(group)))
   }
   if (is.null(group)) grinorder <- factor(1)
 
   if (is.null(group)) group <- 1
 
+
+  if (dss == TRUE) {
+    aux <- purrr::map(grinorder,
+                      ~TraMineR::seqlength(TraMineR::seqdss(seqdata[group == .x,])) |>
+                        max()
+                      ) |>
+      unlist() |>
+      min()
+  } else {
+    aux <- purrr::map(grinorder,
+                      ~TraMineR::seqlength(seqdata[group == .x,]) |>
+                        max()
+                      ) |>
+      unlist() |>
+      min()
+  }
+
+  if (aux <= 1) {
+    if (dss == TRUE) {
+      cli::cli_abort(c(
+        "x" = "Cannot compute transitions rates for sequences if longest (group-specific) sequence length <= 1",
+        "i" = "consider using {.arg dss = FALSE} or different {.arg group} vector"
+      ))
+    } else {
+      cli::cli_abort(c(
+        "x" = "Cannot compute transitions rates if longest (group-specific) sequence length <= 1",
+        "i" = "In case of active grouping, consider using different {.arg group} vector"
+      ))
+    }
+  }
+
+
+
+
   if (weighted == FALSE) {
     weights <- 1
   } else {