У меня есть некоторые данные измерения скорости смещения для вида с тремя различными переменными (экспозиция, сезон и место). Я хотел бы создать сюжет, в котором сезон и экспозиция указаны на оси X, а сайт создан в легенде. Я выполнил это достаточно легко в Excel и хотел бы повторить тот же тип в R. В настоящее время я использую фрагмент кода, который, кажется, работает для другого пользователя с похожим вопросом, но, похоже, это не так. работать с моим?

СЦЕНАРИЙ :

dput(Data2)
structure(list(Season = structure(c(2L, 2L, 2L, 3L, 3L, 3L, 1L, 
1L, 1L, 4L, 4L, 4L, 2L, 2L, 2L, 3L, 3L, 3L, 1L, 1L, 1L, 4L, 4L, 
4L), .Label = c("Autumn", "Spring", "Summer ", "Winter"), class = "factor"), 
Exposure = structure(c(1L, 3L, 2L, 4L, 3L, 2L, 4L, 3L, 2L, 
4L, 3L, 2L, 1L, 3L, 2L, 4L, 3L, 2L, 4L, 3L, 2L, 4L, 3L, 2L
), .Label = c(" Sheltered", "Exposed", "Moderately Exposed", 
"Sheltered"), class = "factor"), Average = c(1L, 2L, 4L, 
3L, 4L, 2L, 2L, 4L, 2L, 4L, 3L, 2L, 2L, 5L, 4L, 3L, 2L, 1L, 
1L, 1L, 2L, 4L, 2L, 2L), Site = c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L), SEM = c(0.5, 0.1, 0.4, 0.5, 1, 0.5, 0.5, 0.5, 
0.5, 0.5, 0.2, 0.5, 0.5, 0.1, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 
0.3, 0.2, 0.5, 0.5)), class = "data.frame", row.names = c(NA, 
-24L))


`setwd("C:/Users/phl5/Documents/PippaPhD")
 getwd()
 read.csv("Graphed_Data.csv")
 Data2<-read.csv("Graphed_Data.csv")

 library(ggplot2)
 library(gtable)
 library(grid)

 dodge<- position_dodge(width=0.9)

 ggplot(Data2, aes(x = interaction(Exposure, Season), y = Average, fill 
  = factor(Site))) +
 geom_bar(stat = "identity", position = position_dodge()) +
 geom_errorbar(aes(ymax = Average + SEM, ymin = Average - SEM), position 
 = dodge, width = 0.2)


 g1<- ggplot(data = Data2, aes(x = interaction(Exposure, Season), y = 
 Average, fill = factor(Site))) +
 geom_bar(stat = "identity", position = position_dodge()) +
 geom_errorbar(aes(ymax = Average + SEM, ymin = Average - SEM), position 
 = dodge, width = 0.2) +
 coord_cartesian(ylim = c(0, 12.5))+ 
 annotate("text", x = 1:12, y = 400,
       label = rep(c("Exposed", "Moderately Exposed", "Sheltered"),4)) +
 annotate("text", c(0.5, 1.5, 2.0, 2.5), y = -800, label = c("Spring", 
 "Summer", "Autumn", "Winter"))+
 theme_classic()+
 theme(plot.margin = unit(c(1,1,1,1), "lines"),
    axis.title.x = element_blank(),
    axis.text.x = element_blank())

 g2 <- ggplot_gtable(ggplot_build(g1))
 g2$layout$clip[g2$layout$name == "panel"] <- "off"
 grid.draw(g2)`

Может кто-нибудь увидеть, является ли очевидная проблема в моем коде, который я использую, или это другой сценарий, который я мог бы использовать?

Код: Вывод из текущего кода, с проблемой отсутствия кодов оси x вообще

Это тот вид вывода, который я хотел бы, и который я могу создать в Excel

Я очень начинающий в R, но любая помощь будет принята с благодарностью.

1
Pippa 11 Апр 2019 в 11:01

2 ответа

Лучший ответ

Изменить 2:

Для второго вопроса ОП в комментарии:

  1. Нет необходимости добавлять geom_hline() для отображения оси, просто добавьте axis.line к theme() и panel.spacing.x=unit(0, "lines"), чтобы сделать его непрерывным через фасеты
gg <- ggplot(aes(x=as.factor(Site), y=Average, fill=as.factor(Site)), data=data)
gg <- gg + geom_bar(stat = 'identity')
gg <- gg + scale_fill_discrete(guide_legend(title = 'Site')) # just to get 'site' instead of 'as.factor(Site)' as legend title
# gg <- gg + scale_fill_manual(values=c('black', 'grey85'), guide_legend(title = 'Site')) # to get bars in black and grey instead of ggplot's default colors
# gg <- gg + theme_classic() # get white background and black axis.line for x- and y-axis
gg <- gg + geom_errorbar(aes(ymin=Average-SEM, ymax=Average+SEM), width=.3)
gg <- gg + facet_wrap(~Season*Exposure, strip.position=c('bottom'), nrow=1, drop=F)
gg <- gg + scale_y_continuous(expand = expand_scale(mult = c(0, .05))) # remove space below zero
gg <- gg + theme(axis.text.x = element_blank(),
                 axis.ticks.x = element_blank(),
                 axis.title.x = element_blank(),
                 axis.line = element_line(color='black'),
                 strip.placement = 'outside', # place x-axis above (factor-label-) strips
                 panel.spacing.x=unit(0, "lines"), # remove space between facets (for continuous x-axis)
                 panel.grid.major.x = element_blank(), # remove vertical grid lines
                 # panel.grid = element_blank(), # remove all grid lines
                 # panel.background = element_rect(fill='white'), # choose background color for plot area
                 strip.background = element_rect(fill='white', color='white')  # choose background for factor labels, color just matters for theme_classic()
)
  1. Чтобы разместить метки экспозиции над метками сезона в полосках фасеток, вы можете изменить накладку gtable на каждую полоску.
# facet factor levels
season.levels <- levels(data$Season)
exposure.levels <- levels(data$Exposure)

# convert to gtable
g <- ggplotGrob(gg)

# find the grobs of the strips in the original plot
grob.numbers <- grep("strip-b", g$layout$name)
# filter strips from layout 
b.strips <- gtable_filter(g, "strip-b", trim = FALSE)
# b.strips$layout shows the strips position in the cell grid of the plot
# b.strips$layout
season.left.panels <- seq(1, by=length(levels(data$Exposure)), length.out = length(season.levels))
season.right.panels <- seq(length(exposure.levels), by=length(exposure.levels), length.out = length(season.levels))
left <- b.strips$layout$l[season.left.panels]
right <- b.strips$layout$r[season.right.panels]
top <- b.strips$layout$t[1]
bottom <- b.strips$layout$b[1]

# create empty matrix as basis to overly new gtable on the strip
mat   <- matrix(vector("list", length = 10), nrow = 2)
mat[] <- list(zeroGrob())

# add new gtable matrix above each strip
for (i in 1:length(season.levels)) {
  res <- gtable_matrix("season.strip", mat, unit(c(1, 0, 1, 0, 1), "null"), unit(c(1, 1), "null"))
  season.left <- season.left.panels[i]
  # place season labels below exposure labels in row 2 of the overlayed gtable for strips
  res <- gtable_add_grob(res, g$grobs[[grob.numbers[season.left]]]$grobs[[1]], 2, 1, 2, 5)
  # move exposure labels to row 1 of the overlayed gtable for strips
  for (j in 0:2) {
    exposure.x <- season.left+j
    res$grobs[[c(1, 5, 9)[j+1]]] <- g$grobs[[grob.numbers[exposure.x]]]$grobs[[2]]
  }
  new.grob.name <- paste0(levels(data$Season)[i], '-strip')
  g <- gtable_add_grob(g, res, t = top,  l = left[i],  b = top,  r = right[i], name = c(new.grob.name))
  new.grob.no <- grep(new.grob.name, g$layout$name)[1]
  g$grobs[[new.grob.no]]$grobs[[nrow(g$grobs[[new.grob.no]]$layout)]]$children[[2]]$children[[1]]$gp <- gpar(fontface='bold')
}

grid.newpage()
grid.draw(g)

Результат выглядит так: введите описание изображения здесь

  1. Чтобы получить столбцы в черном и сером цветах, как показано в примере, измените ggplot следующим образом:
gg <- ggplot(aes(x=as.factor(Site), y=Average, fill=as.factor(Site)), data=data)
gg <- gg + geom_bar(stat = 'identity')
# gg <- gg + scale_fill_discrete(guide_legend(title = 'Site')) # just to get 'site' instead of 'as.factor(Site)' as legend title
gg <- gg + scale_fill_manual(values=c('black', 'grey85'), guide_legend(title = 'Site')) # to get bars in black and grey instead of ggplot's default colors
gg <- gg + theme_classic() # get white background and black axis.line for x- and y-axis
gg <- gg + geom_errorbar(aes(ymin=Average-SEM, ymax=Average+SEM), width=.3)
gg <- gg + facet_wrap(~Season*Exposure, strip.position=c('bottom'), nrow=1, drop=F)
gg <- gg + scale_y_continuous(expand = expand_scale(mult = c(0, .05))) # remove space below zero
gg <- gg + theme(axis.text.x = element_blank(),
                 axis.ticks.x = element_blank(),
                 axis.title.x = element_blank(),
                 axis.line = element_line(color='black'),
                 strip.placement = 'outside', # place x-axis above (factor-label-) strips
                 panel.spacing.x=unit(0, "lines"), # remove space between facets (for continuous x-axis)
                 panel.grid.major.x = element_blank(), # remove vertical grid lines
                 # panel.grid = element_blank(), # remove all grid lines
                 # panel.background = element_rect(fill='white'), # choose background color for plot area
                 strip.background = element_rect(fill='white', color='white')  # choose background for factor labels, color just matters for theme_classic()
)

Результат должен выглядеть так: введите описание изображения здесь < Сильный > Edit:

Для вопроса ОП в комментарии:

  1. Удаление линий сетки можно выполнить с помощью ggplot 'theme():
gg <- ggplot(aes(x=as.factor(Site), y=Average, fill=as.factor(Site)), data=data)
gg <- gg + geom_bar(stat = 'identity')
gg <- gg + geom_errorbar(aes(ymin=Average-SEM, ymax=Average+SEM), width=.3)
gg <- gg + facet_wrap(~Season*Exposure, strip.position=c('bottom'), nrow=1, drop=F)
gg <- gg + scale_fill_discrete(guide_legend(title = 'Site'))
gg <- gg + theme(axis.text.x = element_blank(),
                 axis.ticks.x = element_blank(),
                 axis.title.x = element_blank(),
                 panel.grid.major.x = element_blank(), # remove vertical grid lines
                 # panel.grid = element_blank(), # remove al grid lines
                 # panel.background = element_rect(fill='white'), # choose background color for plot area
                 strip.background = element_rect(fill='white')  # choose background for factor labels
                 )
  1. Иметь только один лейбл для каждого сезона немного сложнее. Вам нужно отредактировать gtable из ggplot. Один из способов сделать это будет следующим:
# facet factor levels
season.levels <- levels(data$Season)
exposure.levels <- levels(data$Exposure)
# convert to gtable
g <- ggplotGrob(gg)
# find the grobs of the strips in the original plot
grob.numbers <- grep("strip-b", g$layout$name)
# filter strips from layout 
b.strips <- gtable_filter(g, "strip-b", trim = FALSE)
# b.strips$layout shows the strips position in the cell grid of the plot
b.strips$layout
season.left.panels <- seq(1, by=length(levels(data$Exposure)), length.out = length(season.levels))
season.right.panels <- seq(length(exposure.levels), by=length(exposure.levels), length.out = length(season.levels))
left <- b.strips$layout$l[season.left.panels]
right <- b.strips$layout$r[season.right.panels]
top <- b.strips$layout$t[1]
bottom <- b.strips$layout$b[1]

# create empty matrix as basis to overly new gtable on the strip
mat   <- matrix(vector("list", length = 10), nrow = 2)
mat[] <- list(zeroGrob())

# add new gtable matrix above each strip
for (i in 1:length(season.levels)) {
  res <- gtable_matrix("season.strip", mat, unit(c(1, 0, 1, 0, 1), "null"), unit(c(1, 1), "null"))
  res <- gtable_add_grob(res, g$grobs[[grob.numbers[season.left.panels[i]]]]$grobs[[1]], 1, 1, 1, 5)
  new.grob.name <- paste0(levels(data$Season)[i], '-strip')
  g <- gtable_add_grob(g, res, t = top,  l = left[i],  b = top,  r = right[i], name = c(new.grob.name))
  new.grob.no <- grep(new.grob.name, g$layout$name)
  g$grobs[[new.grob.no]]$grobs[[nrow(g$grobs[[new.grob.no]]$layout)]]$children[[2]]$children[[1]]$gp <- gpar(fontface='bold')
}
grid.newpage()
grid.draw(g)

enter image description here

<сильный> оригинальный ответ

Я думаю, что то, что вы ищете, можно - используя ggplot() - лучше всего достичь с помощью фасетирования.

data <- expand.grid(c('Spring', 'Summer', 'Autumn', 'Winter'), c('Sheltered', 'Moderately exposed', 'Exposed'), c(1, 2))
names(data) <- c('Season', 'Exposure', 'Site')
# adding some arbitrary values
set.seed(42)
data$Average <- sample(c(rep(3, 3), rep(2, 2), rep(1, 2), rep(NA, 17)))
data$SEM <- NA
SEM <- sample(c(rep(0.5, 3), rep(0.3, 2), rep(.1, 2)))
data$SEM[which(!is.na(data$Average))] <- SEM

gg <- ggplot(aes(x=as.factor(Site), y=Average, fill=as.factor(Site)), data=data)
gg <- gg + geom_bar(stat = 'identity')
gg <- gg + geom_errorbar(aes(ymin=Average-SEM, ymax=Average+SEM), width=.3)
gg <- gg + facet_wrap(~Season*Exposure, strip.position=c('bottom'), nrow=1, drop=F)
gg <- gg + scale_fill_discrete(guide_legend(title = 'Site'))
gg <- gg + theme(axis.text.x = element_blank(),
                 axis.ticks.x = element_blank(),
                 axis.title.x = element_blank())
print(gg)

enter image description here

0
Simon 12 Апр 2019 в 19:08

Так как вы не предоставили примеры данных для своего кода, я пытаюсь выяснить вашу проблему с существующими данными (cars). Посмотрев на желаемый результат, я создал график в r:

library(ggplot2)
ggplot(data = cars, aes(x =  speed, y = dist)) + 
  geom_bar(stat="identity", position = "dodge") 

enter image description here

В вашем коде есть проблема ручного переопределения оси x, чтобы оно было пустым, например:

ggplot(data = cars, aes(x =  speed, y = dist)) + 
  geom_bar(stat="identity", show.legend = F, position = "dodge") + 
  theme(
        axis.title.x = element_blank(),
        axis.text.x = element_blank())

Как видите, ось X и ее метки исчезают, когда вы контролируете axis.title / axis.text

enter image description here

1
heck1 11 Апр 2019 в 08:32