条形颜色由正值或负值区分的多面归一化条形图

时间:2018-11-07 19:34:47

标签: r ggplot2 plot

我有一个这样的数据框:

df<- data.frame(month= rep(c("Jan", "Feb", "Mar", "Apr", "May"), 3), 
       year= c(seq(2001:2003,5), rep(2002, 5), rep(2003, 5)), 
       clim_var= c(rep("precip_mm", 5), rep("tmin",5), rep("tmax", 5)), 
       anomaly= sample(-20:20, 15, replace = TRUE))
df<-df[-c(3,10),]
library("zoo")
df$date<- as.yearmon(paste(df$year, df$month), format= "%Y %b")

您会注意到某些日期可能会丢失,但是在大多数情况下,这是各种气候变量的时间序列数据。我希望每个气候变量都是一个方面。 y轴将为anomaly列的每个级别绘制clim_var。这样我就应该得到一个多面的图,每个图都与此类似:

enter image description here

我已经尝试过此代码(已修改from

library(ggplot2)
gg<- ggplot(df, aes(x= seq_along(date), y = anomaly)) + 
geom_bar(stat = 'identity', aes(fill = anomaly>0), position = 'dodge', col = 
'transparent') + 
theme_bw() + scale_fill_discrete(guide = 'none') + 
labs(x = '', y = 'anomaly')
gg + facet_grid(clim_var~.)
gg+ scale_x_datetime(labels = date_format("%b %Y"))

问题似乎是在绘制日期。好像它没有被识别为日期,因此每个clim_var的数据都占据了绘图区域的1/3,并且x轴是连续值而不是日期。我希望输出具有像这样包含月份和年份的轴标签...

enter image description here

在我的真实数据集中,有很多年的数据,因此最干净的做法是只为Jan指定标签,然后将其他月份保留为不带标签的刻度。任何见解,将不胜感激。

修改:

校正后的数据帧,以使每个clim-var具有多年的数据

precip_mm<- data.frame(clim_var= rep("precip_mm",36),  month= rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec" ), 3), 
                   year= c(rep(2001,12),rep(2002,12), rep(2003, 12)), 
                   anomaly= sample(-20:20, 36, replace = TRUE))
tmin<- data.frame(clim_var= rep("tmin",36),  month= rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec" ), 3), 
                   year= c(rep(2001,12),rep(2002,12), rep(2003, 12)), 
                   anomaly= sample(-20:20, 36, replace = TRUE))
tmax<- data.frame(clim_var= rep("tmax",36),  month= rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec" ), 3), 
                   year= c(rep(2001,12),rep(2002,12), rep(2003, 12)), 
                   anomaly= sample(-20:20, 36, replace = TRUE))
df<- rbind(precip_mm, tmin)
df<-rbind(df, tmax)
df<-df[-c(3,10, 50, 100),]

library("zoo")
df$date<- as.yearmon(paste(df$year, df$month), format= "%Y %b")

评论中建议的调整

library(ggplot2)
gg<- ggplot(df, aes(x= date, y = anomaly)) + 
 geom_bar(stat = 'identity', aes(fill = anomaly>0), position = 'dodge', col = 
         'transparent') + 
theme_bw() + scale_fill_discrete(guide = 'none') + 
labs(x = '', y = 'anomaly')
gg + facet_grid(clim_var~.)
gg+ scale_x_yearmon()

输出并不面向每个clim_var,但是x轴已正确标记。

Edit2:

labels_month <- format(seq(from = min(df$date), to = 
max(df$date), by = "1 months"), "%Y-%b")
labels_month[rep(c(FALSE, TRUE), c(1, 11))] <- ""
labels_month<- as.Date(labels_month, format= "%Y-%b")

x_breaks <- seq(min(df$date), max(df$date), by = "1 months")

p1 <- ggplot(df, aes(x = factor(date), y = df)) +
geom_col(aes(fill = anomoly > 0),
       position = "dodge",
       col = "transparent") +
theme_bw(base_size = 12) + 
scale_fill_discrete(guide = "none") +
labs(x = "", y = "") + 
scale_x_date(expand = c(0.015, 0.015),
           labels = labels_month, 
           breaks = x_breaks) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
facet_grid(climvar ~ ., 
         labeller = label_parsed,
         switch = "y",
         scales = 'free_y') 
p1

2 个答案:

答案 0 :(得分:0)

如果您有很多方面,使用facet_wrap可能会更好,它可以解决这样的缩放问题:

gg<- ggplot(df, aes(x= seq_along(date), y = anomaly)) + 
  geom_bar(stat = 'identity', aes(fill = anomaly>0), position = 'dodge', col = 
             'transparent') + 
  theme_bw() + scale_fill_discrete(guide = 'none') + 
  labs(x = '', y = 'anomaly')
gg + facet_wrap(clim_var~., scales= "free_x")

enter image description here

您可以根据需要使用nrow中的ncolfacet_wrap塑形

因此,日期格式为:

df$date<- as.Date(paste(df$year, df$month, "1", sep="-"), format="%Y-%b-%d")

library(ggplot2)
library(scales)
gg<- ggplot(df, aes(x= date, y = anomaly)) + 
  geom_bar(stat = 'identity', aes(fill = anomaly>0), position = 'dodge', col = 
             'transparent') + 
  theme_bw() + scale_fill_discrete(guide = 'none') + 
  labs(x = '', y = 'anomaly')
gg + facet_wrap(clim_var~., scales= "free")+ scale_x_date(breaks = date_breaks("2 months"),labels = date_format("%m/%y"))

enter image description here

我更喜欢这种方法,因为它为我的日期轴提供了很大的灵活性。

答案 1 :(得分:0)

这是您要寻找的吗?

library(zoo)
library(ggplot2)

set.seed(123)
precip_mm <- data.frame(
  clim_var = rep("precip_mm", 36),
  month = rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec"), 3),
  year = c(rep(2001, 12), rep(2002, 12), rep(2003, 12)),
  anomaly = sample(-20:20, 36, replace = TRUE))
tmin <- data.frame(
  clim_var = rep("tmin", 36),
  month = rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec"), 3),
  year = c(rep(2001, 12), rep(2002, 12), rep(2003, 12)),
  anomaly = sample(-20:20, 36, replace = TRUE))
tmax <- data.frame(
  clim_var = rep("tmax", 36),
  month = rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sept", "Oct", "Nov", "Dec"), 3),
  year = c(rep(2001, 12), rep(2002, 12), rep(2003, 12)),
  anomaly = sample(-20:20, 36, replace = TRUE))
df <- rbind(precip_mm, tmin)
df <- rbind(df, tmax)
df <- df[-c(3, 10, 50, 100), ]
df$date <- as.yearmon(paste(df$year, df$month), format = "%Y %b")


# Setup nice labels for T and P
df$clim_var <- factor(df$clim_var, 
                      levels = c("tmax", "tmin", "precip_mm"),
                      labels = c(expression("T"[max]~anomaly~(degree*C)),
                                 expression("T"[min]~anomaly~(degree*C)),
                                 expression("Precip anomaly ("*"mm)")))
# Plot
p1 <- ggplot(df, aes(x = factor(date), y = anomaly)) +
  geom_col(aes(fill = anomaly > 0),
           position = "dodge",
           col = "transparent") +
  theme_bw(base_size = 12) + 
  scale_fill_discrete(guide = "none") +
  labs(x = "", y = "") + 
  facet_grid(clim_var ~ ., 
             labeller = label_parsed,
             switch = "y",
             scales = 'free_y') +
  theme(strip.placement = 'outside',
        strip.background = element_blank(),
        axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) 
p1

如果要修改x轴,请选中此answer

df$date2 <- as.Date(paste(df$year, df$month, "01", sep = "-"), format = "%Y-%b-%d")
p2 <- ggplot(df, aes(x = date2, y = anomaly)) +
  geom_col(aes(fill = anomaly > 0),
           position = "dodge",
           col = "transparent") +
  theme_bw(base_size = 12) + 
  scale_fill_discrete(guide = "none") +
  labs(x = "", y = "") + 
  facet_grid(clim_var ~ ., 
             labeller = label_parsed,
             switch = "y",
             scales = 'free_y') +
  theme(strip.placement = 'outside',
        strip.background = element_blank())  +
  scale_x_date(date_breaks = "12 months", date_labels = "%b-%Y")
p2