Организовать 4 графика p ie в R

Question

У меня есть четыре отдельных графика p ie с одной и той же заданной цветовой схемой (код идентичен, кроме фрейма данных).

Цвета обозначены, потому что я хочу объединить их в 4-сеточном графике с одной легендой, используя одинаковые обозначенные цвета для каждой из 5 групп (ie. Когда цвета не обозначены, цвета автоматически распределяется в зависимости от размера группы).

Пример данных:

# Data
g = c("D","L","X","A","N","B")
v = c(49,14,9,7,6,5)

df1 = data.frame(group = g, value = v)
set.seed(9) # Just for reproductibility
df2 = data.frame(group = sample(g,size = nrow(df1),replace = F),
                 value = sample(v,size = nrow(df1),replace = F)
                 )

set.seed(8) 
df3 = data.frame(group = sample(g,size = nrow(df1),replace = F),
                 value = sample(v,size = nrow(df1),replace = F)
)

set.seed(7)
df4 = data.frame(group = sample(g,size = nrow(df1),replace = F),
                 value = sample(v,size = nrow(df1),replace = F)
)

Код:

BC <- 

       plot_ly(b_c, labels = ~group, values = ~value, marker = list(colors = c(  '#2ca02c',  '#d62728','#9467bd', '#FF7F0E', '#1F77B4')), type = 'pie',textposition = 'outside',textinfo = 'label+percent') %>%
       layout(title = 'b_c',autosize = F, width = 690, height = 690, margin = m,
              xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
              yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
     BC   

Я просмотрел эти посты , но не смогли определить ответ для прочесывания участков из этих.

Сюжеты, развертываемые в R Plotly

Построение нескольких диаграмм p ie на графике

Я ищу что-то подобное ggarrange в ggplot

У меня есть четыре набора данных, некоторые из которых имеют одинаковые группы (ie. одинаковые имена строк). Для этого я хотел бы использовать тот же цвет.

Я действительно не против цветовой схемы (ie. Может быть любого цвета), но хотел бы иметь объединяющую цветовую легенду для всех 4 круговых диаграмм.

Answer 1

Привет, @ sar, посмотри, решит ли это твою проблему:

library(plotly)
library(dplyr)

# Data
g = c("D","L","X","A","N","B")
v = c(49,14,9,7,6,5)

df1 = data.frame(group = g, value = v)
set.seed(9) # Just for reproductibility
df2 = data.frame(group = sample(g,size = nrow(df1),replace = F),
                 value = sample(v,size = nrow(df1),replace = F)
                 )

set.seed(8) 
df3 = data.frame(group = sample(g,size = nrow(df1),replace = F),
                 value = sample(v,size = nrow(df1),replace = F)
)

set.seed(7)
df4 = data.frame(group = sample(g,size = nrow(df1),replace = F),
                 value = sample(v,size = nrow(df1),replace = F)
)


#Plot

plot_ly(labels = ~group, values = ~value, legendgroup = ~group,
        textposition = 'outside',textinfo = 'label+percent') %>%
  add_pie(data = df1, name = "DF1", domain = list(row = 0, column = 0))%>%
  add_pie(data = df2, name = "DF2", domain = list(row = 0, column = 1))%>%
  add_pie(data = df3, name = "DF3", domain = list(row = 1, column = 0))%>%
  add_pie(data = df4, name = "DF4", domain = list(row = 1, column = 1))%>%
  layout(title = "Pie Charts in Grid", showlegend = T,
         grid=list(rows=2, columns=2),
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

Выход:

EDIT1: Чтобы показать «субтитры» для каждого p ie, вы можете использовать аннотации , вы также можете изменить положение legend . Недостатком аннотаций является то, что вы должны указать положение (в данном случае вручную).

Чтобы избежать наложения, я предлагаю удалить textposition = 'outside'.

. Вы можете загрузить график как .png с помощью Кнопка в правом верхнем углу графика.

#Plot

plot_ly(labels = ~group, values = ~value, legendgroup = ~group, 
        textinfo = 'label+percent') %>%
  add_pie(data = df1, name = "DF1", domain = list(row = 0, column = 0))%>%
  add_pie(data = df2, name = "DF2", domain = list(row = 0, column = 1))%>%
  add_pie(data = df3, name = "DF3", domain = list(row = 1, column = 0))%>%
  add_pie(data = df4, name = "DF4", domain = list(row = 1, column = 1))%>%
  layout(title = "Pie Charts in Grid", showlegend = T,
         grid=list(rows=2, columns=2),
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         legend = list(y = 0.5),
         annotations = list(x = c(.08, .62, .08, .62),
                            y = c(.78, .78, .22, .22),
                            text = c("Pie 1","Pie 2","Pie 3","Pie 4"),
                            xref = "papper",
                            yref = "papper",
                            showarrow = F
                          )
         )

Новый вывод:

EDIT2: Посмотрите шрифт или текстовый шрифт .

Вы можете изменить текст и навести текст по своему усмотрению с помощью шаблона .

Вот редактирование, предлагающее снять метки, чтобы получить больше места для процента и процента округления до 1 десятичного знака git:

#Plot

plot_ly(labels = ~group, values = ~value, legendgroup = ~group, textinfo = 'label+percent',
        texttemplate = "%{percent:.1%}",
        hovertemplate = "%{label} <br> %{percent:.1%} <br> %{value}") %>%
  add_pie(data = df1, name = "DF1", domain = list(row = 0, column = 0))%>%
  add_pie(data = df2, name = "DF2", domain = list(row = 0, column = 1))%>%
  add_pie(data = df3, name = "DF3", domain = list(row = 1, column = 0))%>%
  add_pie(data = df4, name = "DF4", domain = list(row = 1, column = 1))%>%
  layout(title = "Pie Charts in Grid", showlegend = T,
         grid=list(rows=2, columns=2),
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         legend = list(y = 0.5),
         annotations = list(x = c(.08, .62, .08, .62),
                            y = c(.78, .78, .22, .22),
                            text = c("Pie 1","Pie 2","Pie 3","Pie 4"),
                            xref = "papper",
                            yref = "papper",
                            showarrow = F
                          )
         )

Новый вывод: