Тепловая карта с дополнительными значениями в R - PullRequest
0 голосов
/ 23 октября 2019

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

enter image description here

Мой код выглядит следующим образомэто:

TD=data.frame(wday=rep(c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
                         "Saturday"),24), hour=rep(0:23, each=7), N=sample(100:300, 168))

ggplot(TD, aes(hour, wday,  fill=N)) + 
  geom_tile(colour = "white", na.rm = TRUE) +
  theme_bw() + theme_minimal() + 
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) +
  scale_fill_viridis() +
  coord_fixed(xlim = c(0, 23)) +
  geom_text(aes(label=paste(N)), size=4) + 
  scale_x_continuous(breaks=seq(0, 23, 1)) 

1 Ответ

1 голос
/ 23 октября 2019

Самым очевидным решением для меня является включение этих средств в ваш фрейм данных и последующее построение вашей тепловой карты.

library("ggplot2")
library("dplyr")
library("tidyr")
library("viridis")

TD=data.frame(wday=rep(c("Sunday", "Monday", "Tuesday", 
              "Wednesday", "Thursday", "Friday", "Saturday"),24),
              hour=rep(0:23, each=7), 
              N=sample(100:300, 168))

df <- TD %>% group_by(wday) %>% summarise(N=round(mean(N)), hour="avg") %>% rbind(TD)
df <- TD %>% group_by(hour) %>% summarise(N=round(mean(N)), wday="avg") %>% rbind(df)

df$wday <- factor(df$wday, levels=c("Monday", "Tuesday", "Wednesday", "Thursday",
                  "Friday", "Saturday", "Sunday", "avg"))
df$hour <- factor(df$hour, levels=c(as.character(0:23), "avg"))

ggplot(df, aes(hour, wday, fill=N)) + 
  geom_tile(colour="white", na.rm=TRUE) +
  theme_bw() + 
  theme_minimal() + 
  theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank()) +
  scale_fill_viridis() +
  coord_fixed(xlim = c(0, 23)) +
  geom_text(aes(label=paste(N)), size=4) + 
  coord_fixed(xlim=c(0, 25), ratio=1)

enter image description here

РЕДАКТИРОВАТЬ: без заполнения для новых элементов.

df <- TD %>% group_by(hour) %>% summarise(N=round(mean(N)), wday="avg") %>% rbind(TD)
df <- df %>% group_by(wday) %>% summarise(N=round(sum(N)), hour="sum") %>% rbind(df)

df$wday <- factor(df$wday, levels=c("Monday", "Tuesday", "Wednesday", "Thursday",
                                    "Friday", "Saturday", "Sunday", "avg"))
df$hour <- factor(df$hour, levels=c(as.character(0:23), "sum"))

ggplot() + 
  geom_tile(colour="white", data=subset(df, hour!="sum" & wday!="avg"), 
            aes(hour, wday, fill=N)) +
  geom_text(aes(hour, wday, label=N), data=df, inherit.aes=FALSE) +
  scale_x_discrete(limits=levels(df$hour)) +
  scale_y_discrete(limits=levels(df$wday)) +
  theme_bw() +  
  theme_minimal() + 
  theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(),
        axis.title=element_blank()) +
  scale_fill_viridis() +
  coord_fixed(xlim=c(0, 25), ratio=1)

enter image description here

...