Как автоматизировать размещение внутренних меток внутри сложенного барплота? - PullRequest
Новая
       11

Как автоматизировать размещение внутренних меток внутри сложенного барплота?

3 голосов
/ 19 июня 2019

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

stemdata <- structure(list( #had to round some nums below for 100% bar

A = c(7, 17, 76), 
B = c(14, 10, 76),
C = c( 14, 17, 69),
D = c( 4, 10, 86), 
E = c( 7, 17, 76),
F = c(4, 10, 86)), 

.Names = c("Food, travel, accommodations, and procedures",
         "Travel itinerary and dates",
        "Location of the STEM Tour stops",
         "Interactions with presenters/guides",
         "Duration of each STEM Tour stop",
        "Overall quality of the STEM Tour"
         ), 
class = "data.frame", 
row.names = c(NA, -3L)) #4L=number of numbers in each letter vector#

# attach(stemdata)
print(stemdata)
par(mar=c(0, 19, 1, 2.1)) # this sets margins to allow long labels
barplot(as.matrix(stemdata), 

    beside = F, ylim = range(0, 10), xlim = range(0, 100),
    horiz = T, col=colors,  main="N=29", 
    border=F, las=1, xaxt='n', width = 1.03)

text(7, 2, "14%")
text(19, 2, "10%")
text(62, 2, "76%")

text(7, 3.2, "14%")
text(22.5, 3.2, "17%")
text(65.5, 3.2, "69%")

text(8, 4.4, "10%")
text(55, 4.4, "86%")

text(3.5, 5.6, "7%")
text(15, 5.6, "17%")
text(62, 5.6, "76%")

text(9, 6.9, "10%")
text(55, 6.9, "86%")

Ответы [ 2 ]

2 голосов
/ 19 июня 2019

Оставляя базу R как запрошенный OP, мы можем легко автоматизировать внутреннее позиционирование метки (т.е. x координаты) в пределах небольшой функции. 

xFun <- function(x) x/2 + c(0, cumsum(x)[-length(x)])

Теперь, хорошо знать, что barplot невидимо бросает y координаты, мы можем поймать их по присваиванию (здесь byc <- barplot(.)).

В конце концов, просто соберите координаты и метки во фрейме данных labs и выполните цикл по вызовам text в sapply. (Используйте col="white" или col=0 для белых меток, как требуется в другом вопросе .) 

# barplot
colors <- c("gold", "orange", "red")
par(mar=c(2, 19, 4, 2) + 0.1)  # expand margins

byc <- barplot(as.matrix(stemdata), horiz=TRUE, col=colors, main="N=29",  # assign `byc`
               border=FALSE, las=1, xaxt='n')

# labels
labs <- data.frame(x=as.vector(sapply(stemdata, xFun)),  # apply `xFun` here 
                   y=rep(byc, each=nrow(stemdata)),  # use `byc` here
                   labels=as.vector(apply(stemdata, 1:2, paste0, "%")), 
                   stringsAsFactors=FALSE)

invisible(sapply(seq(nrow(labs)), function(x)  # `invisible` prevents unneeded console output
  text(x=labs[x, 1:2], labels=labs[x, 3], cex=.9, font=2, col=0)))

# legend  (set `xpd=TRUE` to plot beyond margins!)
legend(-55, 8.5, legend=c("Medium","High", "Very High"), col=colors, pch=15, xpd=TRUE)

par(mar=c(5, 4, 4, 2) + 0.1)  # finally better reset par to default

Результат

enter image description here

Данные 

stemdata <- structure(list(`Food, travel, accommodations, and procedures` = c(7, 
17, 76), `Travel itinerary and dates` = c(14, 10, 76), `Location of the STEM Tour stops` = c(14, 
17, 69), `Interactions with presenters/guides` = c(4, 10, 86), 
    `Duration of each STEM Tour stop` = c(7, 17, 76), `Overall quality of the STEM Tour` = c(4, 
    10, 86)), class = "data.frame", row.names = c(NA, -3L))
1 голос
/ 19 июня 2019

Рассматриваете ли вы решение tidyverse? 

library(tidyverse) # for dplyr, tidyr, tibble & ggplot2

stemdata %>% 
  rownames_to_column(var = "id") %>% 
  gather(Var, Val, -id) %>% 
  group_by(Var) %>% 
  mutate(id = factor(id, levels = 3:1)) %>% 
  ggplot(aes(Var, Val)) + 
  geom_col(aes(fill = id)) + 
  coord_flip() + 
  geom_text(aes(label = paste0(Val, "%")), 
            position = position_stack(0.5))

Результат:

enter image description here

...