facet_grid показывает состав в процентах с помощью ggplot2 - PullRequest
Новая
       46

facet_grid показывает состав в процентах с помощью ggplot2

0 голосов
/ 25 мая 2018

Я пытаюсь получить сетку фасетов моего фрейма данных.

Цель состоит в том, чтобы суммировать состав (в процентах) каждого клада (A, B, C, D, E,F) для каждого индивида (n = 24).

Также сумма каждой клады не 100%, но в конечном итоге очень близка к ней.Никто из людей не получил Клаву B или F.

Вот мой сценарий R: 

library(scales)
library(reshape)
library(ggplot2)

#Add an id variable for the filled regions
X_clade$ind <- factor(X_clade$ind)
X_clade$days <- factor(X_clade$days)
X_clade$temperature <- factor(X_clade$temperature)
X_clade$D <- NULL
Clade <- c(X_clade$A, X_clade$B, X_clade$C, X_clade$E, X_clade$F)
Abundance= 100*cumsum(Clade)/sum(Clade)
str(X_clade)
Abundance
hist(Clade$A)

#subset
file.29<-X_clade[(X_clade$days == 29),]
file.65<-X_clade[(X_clade$days == 65),]
file.53<-X_clade[(X_clade$days == 53),]

#install.packages("wesanderson")
library(wesanderson)
plot_bar(X_clade)

file.29$B <- NULL
file.29$F <- NULL
seq(0.1,1,by=0.1)

p1<-ggplot(file.29,aes(x = ind, y=Abundance,fill = Clade)) +
  geom_bar(position = "fill",stat = "identity") +    
  scale_y_continuous(labels = percent_format())  +
  theme(panel.background = element_blank(),
        panel.border=element_rect(fill=NA),
        panel.grid.minor = element_blank(),
        axis.text.x=element_text(colour="black",size=11),
        axis.text.y=element_text(colour="black",size=11),
        axis.title =element_blank()) + guides(fill=FALSE) +
  facet_grid(days~temperature,scales="free_x")
p1

p_1M=ggplot(file.29,aes(x = ind, y=Abundance,fill = Clade)) 
p_1M

p2<-ggplot(file.53,aes(x = ind, y=Abundance,fill = Clade)) +
  geom_bar(position = "fill",stat = "identity") +  
  scale_y_continuous(labels = percent_format())  +
  theme(panel.background = element_blank(),
        panel.border=element_rect(fill=NA),
        panel.grid.minor = element_blank(),
        strip.text.x = element_blank(),
        axis.text.x=element_text(colour="black",size=11),
        axis.text.y=element_text(colour="black",size=11),
        axis.title =element_blank()) +guides(fill=FALSE) +
  facet_grid(days~temperature,scales="free_x")
p2

p3<-ggplot(file.65,aes(x = ind, y=Abundance,fill = Clade)) +
  geom_bar(position = "fill",stat = "identity") +  
  scale_y_continuous(labels = percent_format())  +
  theme(panel.background = element_blank(),
        panel.border=element_rect(fill=NA),
        panel.grid.minor = element_blank(),
        strip.text.x = element_blank(),
        axis.text.x=element_text(colour="black",size=11),
        axis.text.y=element_text(colour="black",size=11),
        axis.title =element_blank()) + guides(fill=FALSE) +
  facet_grid(days~temperature,scales="free_x")
p3

library(gridExtra)

grid.arrange(p1, p2, p3, nrow=3)

, но для каждого участка (p1, p2, p3) я получаю одно и то же сообщение об ошибке:Ошибка: Эстетика должна иметь длину 1 или совпадать с данными (8): x, y, fill.

Любое понимание того, как решить эту проблему, было бы прекрасно!Как я уверен, я не далеко от этого.Но все же, весь путь застрял!

Все возможное

Homère

Ответы [ 2 ]

0 голосов
/ 25 мая 2018

Вот версия, которая объединяет purrr с cowplot, чтобы составить список графиков и расположить их вместе.Я имитирую facet_grid, разделяя данные на temperature, создавая отдельные столбцы графиков с facet_wrap.Используя imap, я получаю имя каждого из разделенных фреймов данных - температуру - и использую его для заголовков.Затем я делаю несколько забавные вещи, чтобы извлечь легенду, удалить легенду с обоих графиков, сделать текст полосы на левом графике невидимым и нанести их все рядом друг с другом. 

library(tidyverse)


df2 <- df %>%
  mutate_at(vars(days, temperature, ind), as.factor) %>%
  gather(key = group, value = value, -ind, -days, -temperature) %>%
  mutate(value = value / 100)

plots <- df2 %>%
  split(.$temperature) %>%
  imap(function(dat, temp) {
    ggplot(dat, aes(x = ind, y = value, fill = group)) +
      geom_col() +
      scale_y_continuous(labels = scales::percent) +
      scale_fill_discrete(drop = T) +
      labs(x = NULL, y = NULL) +
      facet_wrap(~ days, ncol = 1, scales = "free_x", strip.position = "right") +
      theme_minimal() +
      theme(strip.text.y = element_text(angle = 0, face = "italic"), 
            plot.title = element_text(hjust = 0.5, face = "italic")) +
      ggtitle(paste0(temp, "°C"))
  })

Например,Первый столбец графиков выглядит следующим образом: 

plots[[1]]

Я сделал текст полосы в первом столбце белым, чтобы он соответствовал фону полосы, потому что я хотел, чтобы он все еще занималнекоторое пространство (поэтому столбцы будут иметь одинаковую ширину), но не будут видны. 

legend <- cowplot::get_legend(plots[[1]])
no_legends <- plots %>% map(~. + theme(legend.position = "none"))
no_legends[[1]] <- no_legends[[1]] + theme(strip.text = element_text(color = "white"))

Используя cowplot и следуя одной из его виньеток , я сделал одну сетку издва графика без легенд, и вторая сетка этой первой сетки плюс легенда, и отрегулируйте относительную ширину, чтобы соответствовать хорошо.Здесь вы можете многое сделать и настроить. 

two_plots <- cowplot::plot_grid(plotlist = no_legends)
cowplot::plot_grid(two_plots, legend, rel_widths = c(2, 0.25))

Создано в 2018-05-25 с помощью пакета contex (v0.2.0).

0 голосов
/ 25 мая 2018

Одним из решений может быть нанесение данных с помощью facet_wrap, отключите метки полос и добавьте нужные метки, используя inkscape или photoshop.

library(tidyverse)
d %>% 
  gather(k, v, -days, -ind, -temperature) %>%
  ggplot(aes(x = factor(ind), y=v, fill = k)) +
  geom_col() +
  scale_y_continuous(labels = function(x) paste0(x, "%"))  +
  facet_wrap(~temperature + days, scales="free_x", dir = "v", ncol=2) + 
  theme(strip.text = element_blank(),
        legend.position = "bottom")

enter image description here

Или попробуйте это 

p1 <- d %>% 
  gather(k, v, -days, -ind, -temperature) %>% 
  filter(days == 29) %>% 
  ggplot(aes(x = factor(ind), y=v, fill = k)) +
  geom_col() +
  scale_y_continuous(labels = function(x) paste0(x, "%"))  +
  facet_grid(days~temperature, scales="free_x")+
  xlab("") + 
  theme(legend.position = "none")

p2 <- d %>% 
  gather(k, v, -days, -ind, -temperature) %>% 
  filter(days == 53) %>% 
  ggplot(aes(x = factor(ind), y=v, fill = k)) +
  geom_col() +
  scale_y_continuous(labels = function(x) paste0(x, "%"))  +
  facet_grid(days~temperature, scales="free_x")+
  xlab("") + 
  theme(strip.text.x = element_blank(),
        legend.position = "none")

p3 <- d %>% 
  gather(k, v, -days, -ind, -temperature) %>% 
  filter(days == 65) %>% 
  ggplot(aes(x = factor(ind), y=v, fill = k)) +
  geom_col() +
  scale_y_continuous(labels = function(x) paste0(x, "%"))  +
  facet_grid(days~temperature, scales="free_x")+
  theme(strip.text.x = element_blank(),
        legend.position = "none")

p4 <- d %>% 
  gather(k, v, -days, -ind, -temperature) %>% 
  ggplot(aes(x = factor(ind), y=v, fill = k)) +
  geom_col() +
  theme_void()

library(cowplot)         
cowplot::plot_grid(plot_grid(p1, p2, p3, ncol = 1), get_legend(p4), rel_widths = c(0.9,0.1))

enter image description here

...