R: Tidy Aggregation of Sequence Data and Visualization of Stepfunctions

Question

I have some patient data, where the individual patients change treatment groups over time. My goal is to visualize the sequence of group changes and aggregate this data into a "sequence profile" for each treatment group.

For each treatment group I would like to show, when it generally occurs in the treatment cycle (say rather in the beginning or in the end). To account for the differing sequence length, I would like to standardize these profiles betweenn 0 (very beginning) and 1 (end).

I would like to find an efficient data preparation and visualization.

Mininmal Example

Structure of Data

library(dplyr)
library(purrr)
library(ggplot2)

# minimal data
cj_df_raw <- tibble::tribble(
  ~id, ~group,
    1,    "A",
    1,    "B",
    2,    "A",
    2,    "B",
    2,    "A"
  )

# compute "intervals" for each person [start, end]
cj_df_raw %>% 
  group_by(id) %>% 
  mutate(pos = row_number(),
         len = length(id),
         start = (pos - 1) / len,
         end = pos / len) %>% 
  filter(group == "A")
#> # A tibble: 3 x 6
#> # Groups:   id [2]
#>      id group   pos   len start   end
#>   <dbl> <chr> <int> <int> <dbl> <dbl>
#> 1     1 A         1     2 0     0.5  
#> 2     2 A         1     3 0     0.333
#> 3     2 A         3     3 0.667 1

(So Id 1 was in group A in the first 50% of their sequence, and Id 2 was in Group A in the first 33% and the last 33% of their sequence. This means, that 2 Ids where between 0-33% of the sequence, 1 between 33-50%, 0 between 50-66% and 1 above 66%.)

This is the result I would like to achieve and I miss a chance to transform my data effectively.

Desired outcome

profile_treatmen_a <- tibble::tribble(
    ~x, ~y,
     0, 0L,
  0.33, 2L,
   0.5, 1L,
  0.66, 0L,
     1, 1L,
     1, 0L
  )

profile_treatmen_a %>% 
  ggplot(aes(x, y)) +
  geom_step(direction = "vh") +
  expand_limits(x = c(0, 1), y = 0)

(Ideally the area under the curve would be shaded)

Ideal solution: via ggridges

The goal of the visualization would be to compare the "sequence-profile" of many treatment-groups at the same time. If I could prepare the data accordingly, I would like to use the ggridges-package for a striking visual comparison the treatment groups.

library(ggridges)

data.frame(group = rep(letters[1:2], each=20),
           mean = rep(2, each=20)) %>% 
  mutate(count = runif(nrow(.))) %>% 
  ggplot(aes(x=count, y=group, fill=group)) +
  geom_ridgeline(stat="binline", binwidth=0.5, scale=0.9)

Answer 1

You could build helper intervals and then just plot a histogram. Since each patient is either in Group A or B both groups sum up to 100%. With these helper intervals you could also easily switch to other geoms.

library(tidyverse, warn.conflicts = FALSE)
library(ggplot2)

# create sample data
set.seed(42)

id <- 1:10 %>% map(~ rep(x = .x, times = runif(n = 1, min = 1, max = 6))) %>%
  unlist()
group <- sample(x = c("A", "B"), size = length(id), replace = TRUE) %>%
  as_factor()
df <- tibble(id, group)
glimpse(df)
#> Observations: 37
#> Variables: 2
#> $ id    <int> 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 4, 4, 4, 4, 4, 5, 5,...
#> $ group <fct> A, B, B, A, A, B, B, A, A, B, B, A, B, B, A, B, A, B, A,...

# tidy data
df <- df %>%
  group_by(id) %>%
  mutate(from = (row_number() - 1) / n(),
         to = row_number() / n()) %>%
  ungroup() %>%
  rowwise() %>%
  mutate(list = seq(from + 1/60, to, 1/60) %>% list()) %>%
  unnest()

# plot
df %>%
  ggplot(aes(x = list, fill = group)) +
  geom_histogram(binwidth = 1/60) +
  ggthemes::theme_hc()

Created on 2018-09-16 by the [reprex package](http://reprex.tidyverse.org) (v0.2.0).

Answer 2

My attempt at an answer.. although it is probably not the nicest/fastest/most efficient way, I think it might help you in your efforts.

library(data.table)
# compute "intervals" for each person [start, end]
df <- cj_df_raw %>% 
  group_by(id) %>% 
  mutate(pos = row_number(),
         len = length(id),
         from = (pos - 1) / len,
         to = pos / len,
         value = 1)

dt <- as.data.table(df)
setkey(dt, from, to)

#create intervals
dt.interval <- data.table(from = seq( from = 0, by = 0.01, length.out = 100),
                          to = seq( from = 0.01, by = 0.01, length.out = 100))

#perform overlap join on intervals
dt2 <- foverlaps( dt.interval, dt, type = "within", nomatch = NA)[, sum(value), by = c("i.from", "group")]
#some melting ans casting to fill in '0' on empty intervals
dt3 <- melt( dcast(dt2, ... ~ group, fill = 0), id.vars = 1 )

#plot
ggplot( dt3 ) +
  geom_step( aes( x = i.from, y = value, color = variable ) ) + 
  facet_grid( .~variable )