Как добавить вторую ось x к сюжетному подзаголовку

#r #plotly #r-plotly

Вопрос:

Как я могу добавить вторую ось x, которая показывает название группы штриховых диаграмм?

Поскольку это легче объяснить с помощью изображений, я включил текущую сцену слева, и я хотел бы создать сюжет справа. Код для создания графика слева находится внизу.

В основном я хочу знать, как добавить подгруппы mode1, mode2, mode3, mode4 на ось x.

Несколько бонусных очков:

  • Замена звезд значком
  • Размещение текста об авторских правах в правой нижней части диаграммы
  • Размещение пояснительного текста в левом нижнем углу диаграммы.

Мне удалось добавить эти тексты с аннотациями, но они не всегда идеально расположены, и мне также приходится экспортировать текст с помощью orca, а затем иногда эти тексты обрезаются. Поэтому мой вопрос в том, как мне идеально расположить их в нижних углах?

введите описание изображения здесь

Код:

 library(data.table)
library(plotly)

## DATA ################

mobil_indic <- structure(list(
  time_labels = structure(c(5L, 4L, 2L, 7L, 6L, 1L, 3L, 8L, 7L, 4L, 2L, 3L, 1L, 6L, 5L, 3L, 1L, 2L, 5L, 4L, 6L, 
                            4L, 1L, 2L, 3L, 5L, 7L, 7L, 5L, 6L, 8L, 4L, 8L, 6L, 7L, 5L, 4L, 4L, 3L, 2L, 6L, 5L, 6L, 3L, 4L, 2L, 5L, 1L), 
                          .Label = c("timegroup8","timegroup7", "timegroup6", "timegroup5", "timegroup4", "timegroup3", 
                                     "timegroup2", "timegroup1"), class = c("ordered", "factor")), 
  mode = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
                     1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), 
                   .Label = c("mode1", "mode2","mode3", "mode4"), class = c("ordered", "factor")), 
  process_id = c(1969L, 1969L, 1969L, 1969L, 1969L, 1969L, 1969L, 1970L, 1970L, 1970L, 
                 1970L, 1970L, 1970L, 1970L, 1970L, 1969L, 1969L, 1969L, 1969L, 1969L, 1970L, 1970L, 1970L, 1970L,
                 1970L, 1970L, 1970L, 1969L, 1969L, 1969L, 1969L, 1969L, 1970L, 1970L, 1970L, 1970L, 1970L, 
                 1969L, 1969L, 1969L, 1969L, 1969L, 1970L, 1970L, 1970L, 1970L, 1970L, 1970L), 
  anteil = c(4, 30, 32, 5, 5, 18, 6, 0, 3, 20, 21, 13, 31, 7, 5, 7, 80, 8, 3, 2, 0, 2, 84, 6, 7, 1, 0, 33, 
             16, 25, 11, 15, 9, 26, 23, 19, 23, 32, 32, 20, 4, 11, 4, 33, 30, 20, 9, 3), 
  colors = c("#A4CFE5", "#538C4A", "#E7877D", "#3F83C1", "#72B6E0", "#953735", "#7EB24E", "#326C9F", "#3F83C1", 
             "#538C4A", "#E7877D", "#7EB24E", "#953735", "#72B6E0", "#A4CFE5", "#7EB24E", "#953735", "#E7877D", "#A4CFE5", "#538C4A", "#72B6E0", 
             "#538C4A", "#953735", "#E7877D", "#7EB24E", "#A4CFE5", "#3F83C1", "#3F83C1", "#A4CFE5", "#72B6E0", "#326C9F", "#538C4A", "#326C9F", 
             "#72B6E0", "#3F83C1", "#A4CFE5", "#538C4A", "#538C4A", "#7EB24E", "#E7877D", "#72B6E0", "#A4CFE5", "#72B6E0", "#7EB24E", "#538C4A", 
             "#E7877D", "#A4CFE5", "#953735")), 
  class = "data.frame", row.names = c(NA, -48L))

npermode <- structure(list(
  process_id = c("1969", "1970", "1969", "1970", "1969", "1970", "1969", "1970"),
  mode = structure(c(4L, 4L, 1L, 1L, 2L, 2L, 3L, 3L), .Label = c("mode1", "mode2", "mode3", "mode4"), class = c("ordered","factor")), 
  sum_time = c(550, 848, 4583.35, 7075, 1650, 2547, 1645, 2365), 
  n = c(58L, 79L, 58L, 79L, 58L, 79L, 58L, 79L), 
  labels = c("mode4", "mode4", "mode1", "mode1", "mode2", "mode2", "mode3", "mode3"),
  type = c("Type1", "Type2", "Type1", "Type2", "Type1", "Type2","Type1", "Type2"), 
  xlabs = c("Type1n(n=58)", "Type2n(n=79)", "Type1n(n=58)", "Type2n(n=79)", 
            "Type1n(n=58)", "Type2n(n=79)", "Type1n(n=58)", "Type2n(n=79)")), 
  class = "data.frame", row.names = c(NA, -8L))

## WRANGLING ################
setDT(mobil_indic)
setDT(npermode)

mobil_indic[, process_id := as.character(process_id)]
mobil_indic <- merge(mobil_indic, npermode, by=c("process_id","mode"))

## Plot ###########
mobil_indic$showlegend = FALSE
mobil_indic[mobil_indic$mode == mobil_indic$mode[[1]],]$showlegend = TRUE
p <- lapply(split(mobil_indic, mobil_indic$mode), function(x) {
  x <- x %>% arrange(time_labels, mode)
  plot_ly(data = x, hoverinfo = "text") %>%
    add_trace(type = "bar",
              x=~xlabs,
              y=~anteil,
              name = ~time_labels,
              showlegend = ~showlegend[[1]],
              legendgroup = ~time_labels,
              marker = list(color = ~colors, fontsize = 12, line = list(width = 1.2, color = 'white')),
              text = ~paste0(anteil, "%"),
              textposition = 'inside', insidetextanchor = "middle",
              hovertext = ~sprintf("<b>Mode</b>: %sn<b>time</b>: %sn<b>perc</b>: %s%%",
                                   mode, time_labels, anteil)
    )
})

subplot(p, nrows = 1, shareY = TRUE) %>%
  plotly::layout(title = paste0("<b>Some Title</b>"),
                 barmode = "stack")
 

Ответ №1:

Вы могли бы использовать аннотации

 mobil_split = split(mobil_indic, mobil_indic$mode)
labs = names(mobil_split)

p <- lapply(labs, function(lab) {
  x = mobil_split[[lab]]
  x <- x %>% arrange(time_labels, mode)
  plot_ly(data = x, hoverinfo = "text") %>%
    add_trace(type = "bar",
              x=~xlabs,
              y=~anteil,
              name = ~time_labels,
              showlegend = ~showlegend[[1]],
              legendgroup = ~time_labels,
              marker = list(color = ~colors, fontsize = 12, line = list(width = 1.2, color = 'white')),
              text = ~paste0(anteil, "%"),
              textposition = 'inside', insidetextanchor = "middle",
              hovertext = ~sprintf("<b>Mode</b>: %sn<b>time</b>: %sn<b>perc</b>: %s%%",
                                   mode, time_labels, anteil)
    ) %>%
    layout(annotations = list(x = 0.5 , y = -5, text = lab, showarrow = F))
})

subplot(p, nrows = 1, shareY = TRUE) %>%
  layout(title = paste0("<b>Some Title</b>"), barmode = "stack"
  )
 

введите описание изображения здесь

Комментарии:

1. Спасибо за предложение, но аннотации находятся над метками по оси x. Они должны быть ниже их

Ответ №2:

Это должно сработать:

 mobil_split = split(mobil_indic, mobil_indic$mode)
labs = names(mobil_split)
p <- lapply(labs, function(lab) {
  x = mobil_split[[lab]]
  x <- x %>% arrange(time_labels, mode)
  plot_ly(data = x, hoverinfo = "text") %>%
    add_trace(type = "bar",
              x=~xlabs,
              y=~anteil,
              name = ~time_labels,
              showlegend = ~showlegend[[1]],
              legendgroup = ~time_labels,
              marker = list(color = ~colors, fontsize = 12, line = list(width = 1.2, color = 'white')),
              text = ~paste0(anteil, "%"),
              textposition = 'inside', insidetextanchor = "middle",
              hovertext = ~sprintf("<b>Mode</b>: %sn<b>time</b>: %sn<b>perc</b>: %s%%",
                                   mode, time_labels, anteil)
    ) %>% 
    plotly::layout(xaxis = list(title=lab))
})

subplot(p, nrows = 1, shareY = TRUE, titleX = TRUE) %>%
  plotly::layout(title = paste0("<b>Some Title</b>"),
                 barmode = "stack")