Многогранная нормализованная гистограмма с цветом гистограммы, дифференцированным по положительному или отрицательному значению

Question

У меня есть фрейм данных:

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. Такую, что я должен получить многофакторную фигуру, каждый график которой похож на этот:

Я пробовал этот код (модифицированный из )

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 представляет собой непрерывные значения, а не даты. Я хочу, чтобы выходные данные имели метку оси, включающую месяц и год, например ...

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

Редактировать:

Исправленный фрейм данных, так что каждый 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 правильно помечена.

Редактировать2:

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

Answer 1

Это то, что вы ищете?

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, отметьте ответ

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

Answer 2

Возможно, вам лучше использовать 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")

Вы можете использовать nrow и ncol от facet_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"))

Я предпочитаю этот метод, поскольку он дает мне большую гибкость для моей оси дат.