Início / coding / Perguntas / 79584777
Accepted
user30330533
Asked: 2025-04-21 22:09:24 +0800 CST

Exibindo porcentagens de estratos em parcelas aluviais

  • 772

Tenho dados de um estudo de intervenção com 4 grupos experimentais (Grupo) e três pontos de medição (Tempo). Realizei uma análise de perfil e transição, que resultou em 4 perfis (Perfil). Criei um diagrama aluvial mostrando as transições dos perfis entre os pontos de medição para cada grupo experimental.

library(ggplot2)
library(ggalluvial)
library(dplyr)
library(tidyr)

df <- tibble(id = 1:400, group = sample(1:4, size = 400, replace = TRUE)) |>
crossing(time = 1:3) |>
mutate(profile = sample(1:4, size = n(), replace = TRUE))|>
mutate(profile = as.character(profile), time = as.character(time))


ggplot(df, aes(x = time, stratum = profile, alluvium = id, fill = profile, label = profile)) +
    scale_fill_brewer(type = "seq", palette = "BrBG") +
    geom_flow() +
    geom_stratum() +
    labs(x = "Time", y = "N") +
    facet_wrap('group', labeller = label_both)

Como os 4 grupos não têm o mesmo tamanho amostral, gostaria de plotar os tamanhos relativos dos estratos em vez dos absolutos, de modo que todos os perfis para cada ponto no tempo totalizem 100%. Não sei como fazer isso. Usar o atributo de peso não funcionou.

3 respostas

  1. Best Answer

    Como outra abordagem, você pode introduzir weightmanualmente e usá-lo diretamente como yvalor + usar scale_y_continuous(labels = scales::percent_format())para marcar as porcentagens relativas

    fora

    library(ggplot2)
library(ggalluvial)
library(dplyr)
library(tidyr)

set.seed(1) # set seed because we sample

df <- tibble(id = 1:400, group = sample(1:4, size = 400, replace = TRUE)) |>
  crossing(time = 1:3) |>
  mutate(profile = sample(1:4, size = n(), replace = TRUE))|>
  mutate(profile = as.character(profile), time = as.character(time))|>
  mutate(total = n(), .by=c(group, time)) |>
  mutate(weight = 1/total)

ggplot(df,
       aes(x = time,
           y = weight, # use weight here
           stratum = profile, 
           alluvium = id,
           fill = profile, 
           label = profile)) + 
  scale_fill_brewer(type = "seq", palette = "BrBG") +
  geom_flow(alpha = 0.6) +
  geom_stratum() +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(x = "Time", y = "Percentage") +
  facet_wrap('group', labeller = label_both)
    • 3

  2. Aqui está outro método formatando cada "faceta" separadamente e combinando os gráficos usando patchwork:

    df |>
  group_split(df, group) -> df_grp

lapply(seq_along(df_grp), function(i) {
 ggplot(df_grp[[i]], aes(x = time, stratum = profile, alluvium = id, 
                         group = profile, fill = profile, label = profile)) +
  scale_fill_brewer(type = "seq", palette = "BrBG") +
  geom_flow() +
  geom_stratum() +
  labs(x = "Time", y = "Prop") +
  scale_y_continuous(breaks = seq(from = 0, to = n_distinct(df_grp[[i]]$id),
                                length.out = 5), 
                     label = scales::percent_format(scale = 100 / 
                                        n_distinct(df_grp[[i]]$id))) +
    facet_wrap('group', labeller = label_both)}) |>
wrap_plots(guides = "collect", axes = "collect")

    • 3 
  3. library(ggplot2)
library(ggalluvial)
library(dplyr)
library(tidyr)

    df <- tibble(id = 1:400, group = sample(1:4, size = 400, replace = TRUE)) |>
  crossing(time = 1:3) |>
  mutate(profile = sample(1:4, size = n(), replace = TRUE)) |>
  mutate(profile = as.character(profile), time = as.character(time)) |>
  # calculate the percentages
  group_by(group, time) |>
  mutate(n = n()) |>
  group_by(group, time, profile) |>
  mutate(n2 = n(), pct = n2/n)

    ggplot(df, aes(x = time, stratum = profile, alluvium = id, fill = profile, label = profile)) +
  scale_fill_brewer(type = "seq", palette = "BrBG") +
  geom_flow() +
  geom_stratum() +
  geom_text(stat = 'stratum', aes(label = paste0(round(pct *100, ), '%')), vjust = 1, size = 3, color = 'white') +
  labs(x = "Time", y = "N") +
  facet_wrap('group', labeller = label_both)

    insira a descrição da imagem aqui

    • 2

relate perguntas