Как избежать наложения между сегментами при построении диаграммы Ганта с ggplot в R - PullRequest
Новая
       41

Как избежать наложения между сегментами при построении диаграммы Ганта с ggplot в R

1 голос
/ 06 апреля 2020

Уважаемые, у меня есть вопрос, касающийся построения диаграммы Ганта с помощью ggplot в R. Всякий раз, когда я строю свои данные, между сегментами возникает совпадение. Например (согласно приложенному графику), вы увидите, что продукт A1 должен иметь четыре сегмента (согласно приложенным данным), но из-за перекрытия вы можете видеть, что есть только два сегмента (согласно приложенной ссылке на изображение). Я хотел бы построить каждый сегмент для одного и того же продукта в отдельном ряду, чтобы избежать такого дублирования. После того, как у меня есть каждый сегмент в строке, я бы хотел, чтобы название продукта для группы сегментов отображалось только один раз. Я прилагаю код, который я использовал в дополнение к сюжету.

Заранее спасибо Мохамед 

Product Codes   Batch Number    Start   End
A                  1            1000    1500
A                  1            1400    2000
A                  1            1800    2300
A                  1            6573    6905
A                  2            13773   14105
A                  2            5040    5372
A                  2            720     1052
A                  3            1921    2253
A                  3            3933    4265
A                  3            13441   13773

library(ggplot2)
library(grid)
library(dplyr)
library(gtable)
library(readxl)
library(readxl)
library(reshape2)
library(ggrepel)
library(RColorBrewer)

Book2 <- read_excel("C:/Users/...stack.xlsx", sheet = "Sheet1")
attach(Book2)
df2<-Book2

actcols <- c("#d95f0e","#756bb1","#0218a2","#ffb703", "#f76f73", "#027fdc", "#07c4c5","#303030","#11793b","#5d7261","#3f5f34","#905435","#997940","#ab3434","#961B4D")
myColors <- brewer.pal(5,"Set1")

start<-as.POSIXct('04/06/2020',format='%m/%d/%Y') 

date<-(df2$Start)*60+start
zz2<-(df2$End)*60+start

Product<-paste(df2$`Product Codes`,df2$`Batch Number`)

plot2 <-  ggplot(df2, aes(x=date,xend=zz2-900,y=Product, yend=Product,color=Product))+ geom_segment(stat = "identity")+ theme_bw()+ geom_segment(size=5)+ 
  theme(plot.title=element_text(size=24, face="bold"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=14),
        axis.title.x=element_text(size=16),
        axis.title.y=element_text(size=14),
        legend.title = element_text(size=16),
        legend.position="top")+scale_x_datetime(date_labels ="%a %b %d",  date_breaks  ="1 day") +
  theme(axis.text.x = element_text(hjust=2.5))
plot2

enter image description here

1 Ответ

1 голос
/ 07 апреля 2020

Попробуйте это. Основа c Идея состоит в том, чтобы добавить номера сегментов к вашей переменной Product и сопоставить новую переменную Product_segment с y: 

library(RColorBrewer)
library(ggplot2)
library(dplyr)

df2 <- read.table(text = "'Product Codes'   'Batch Number'    Start   End
A                  1            1000    1500
A                  1            1400    2000
A                  1            1800    2300
A                  1            6573    6905
A                  2            13773   14105
A                  2            5040    5372
A                  2            720     1052
A                  3            1921    2253
A                  3            3933    4265
A                  3            13441   13773", header = TRUE, stringsAsFactors = FALSE)

df2 <- df2 %>% 
  rename(`Product Codes` = Product.Codes, `Batch Number` = Batch.Number)

actcols <- c("#d95f0e","#756bb1","#0218a2","#ffb703", "#f76f73", "#027fdc", "#07c4c5","#303030","#11793b","#5d7261","#3f5f34","#905435","#997940","#ab3434","#961B4D")
myColors <- brewer.pal(5,"Set1")

start<-as.POSIXct('04/06/2020',format='%m/%d/%Y') 

# Data wrangling
df3 <- df2 %>%
  mutate(
    date = Start * 60 + start,
    zz2 = End * 60 + start  - 900,
    Product = paste(`Product Codes`, `Batch Number`)
  ) %>% 
  select(-Start, -End) %>% 
  # Add segment number
  group_by(Product) %>% 
  arrange(Product, date) %>% 
  mutate(segment = 1,
         segment = cumsum(segment),
         Product_segment = paste(Product, segment),
         y.labels = ifelse(segment == n_distinct(segment), Product, "")) %>% 
  ungroup() 

y.labels <- df3$y.labels

plot2 <-  ggplot(df3, aes(x = date, xend = zz2, y = Product_segment, yend = Product_segment, color = Product)) + 
  geom_segment(size = 10) + 
  scale_x_datetime(date_labels ="%a %b %d",  date_breaks  ="1 day") +
  scale_y_discrete(labels = y.labels) +
  labs(x = NULL, y = NULL) +
  theme_bw() + 
  theme(plot.title=element_text(size=24, face="bold"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=14),
        axis.title.x=element_text(size=16),
        axis.title.y=element_text(size=14),
        legend.title = element_text(size=16),
        legend.position="top")
plot2

Редактировать: Субплоты 

subplot2 <-  ggplot(df3, aes(x = date, xend = zz2, y = factor(segment), yend = factor(segment), color = Product)) + 
  geom_segment(size = 9) + 
  scale_x_datetime(date_labels ="%a %b %d",  date_breaks  ="1 day") +
  labs(x = NULL, y = NULL) +
  facet_wrap(~ Product, ncol = 1, scales = "free_y") +
  theme_bw() + 
  theme(plot.title=element_text(size=24, face="bold"), 
        axis.text.x=element_text(size=10), 
        axis.text.y=element_text(size=14),
        axis.title.x=element_text(size=16),
        axis.title.y=element_text(size=14),
        legend.title = element_text(size=16),
        legend.position="top")
subplot2

Создано в 2020-04-08 пакетом Представить (v0.3.0)

...