ggplot2: Групповые столбцы с 3-сторонним взаимодействием, сложенные штриховым рисунком

Question

Я пытаюсь построить сложную гистограмму + двухстороннее взаимодействие на панели, включая ту же диаграмму для 4 экспериментов. Однако я не мог уклониться от баров в зависимости от одной из независимых переменных. Ниже приведены мои данные.

Сначала я прочитал данные по коду ниже.

a<-read.table(file.choose(), header=T, dec=",") 

Exp. \t Gest \t lag \t Sint12 \t Rev12 \t c12 \t t1pi \t t2pi \t t1i \t t2i \t IntWeak \t inc \t Total 
 
1 \t 1 \t 1 \t 15,88 \t 3,28 \t 22,52 \t 11,76 \t 4,08 \t 2,28 \t 16,76 \t 3,24 \t 20,2 \t 100 
 
1 \t 1 \t 3 \t 0,88 \t 1,2 \t 61,36 \t 11,84 \t 8,4 \t 1,84 \t 2,32 \t 0,8 \t 11,36 \t 100 
 
1 \t 1 \t 8 \t 0,24 \t 0,24 \t 65,2 \t 10,24 \t 9,2 \t 1,84 \t 2,4 \t 0,48 \t 10,16 \t 100 
 
1 \t 2 \t 1 \t 14,96 \t 4 \t 25,28 \t 15,12 \t 1,92 \t 0,68 \t 16,8 \t 1,56 \t 19,68 \t 100 
 
1 \t 2 \t 3 \t 1,2 \t 0,72 \t 79,36 \t 8,64 \t 2,88 \t 0,64 \t 0,64 \t 0,64 \t 5,28 \t 100 
 
1 \t 2 \t 8 \t 0,16 \t 0,16 \t 86,72 \t 5,36 \t 3,2 \t 0,08 \t 0,48 \t 0,64 \t 3,2 \t 100 
 
2 \t 1 \t 1 \t 30,6 \t 2,2 \t 24,48 \t 4,56 \t 1,32 \t 0,4 \t 17,8 \t 1 \t 17,64 \t 100 
 
2 \t 1 \t 3 \t 0,96 \t 1,04 \t 87,2 \t 5,04 \t 2,16 \t 0,16 \t 0,4 \t 0,8 \t 2,24 \t 100 
 
2 \t 1 \t 8 \t 0,88 \t 0,24 \t 91,92 \t 3,28 \t 1,52 \t 0 \t 0,32 \t 0,88 \t 0,96 \t 100 
 
2 \t 2 \t 1 \t 20,16 \t 2,32 \t 16,52 \t 14,24 \t 0,72 \t 0,44 \t 15,96 \t 1,76 \t 27,88 \t 100 
 
2 \t 2 \t 3 \t 1,04 \t 0,64 \t 83,84 \t 5,84 \t 2 \t 0,08 \t 0,72 \t 1,12 \t 4,72 \t 100 
 
2 \t 2 \t 8 \t 0,24 \t 0 \t 91,04 \t 4,16 \t 1,52 \t 0,08 \t 0 \t 0,72 \t 2,24 \t 100 
 
3A \t 1 \t 1 \t 35,83 \t 3,92 \t 27,42 \t 2,42 \t 2,08 \t 0,25 \t 7,42 \t 3,63 \t 17,04 \t 100,01 
 
3A \t 1 \t 3 \t 1,58 \t 1 \t 81 \t 4,5 \t 3,33 \t 0,25 \t 0,33 \t 1,08 \t 6,92 \t 99,99 
 
3A \t 1 \t 8 \t 1 \t 0 \t 86,92 \t 3,17 \t 1,75 \t 0,08 \t 0,42 \t 0,33 \t 6,33 \t 100 
 
3A \t 2 \t 1 \t 43,46 \t 2,38 \t 21,29 \t 1,88 \t 1,17 \t 0,17 \t 5,46 \t 4,21 \t 20 \t 100,02 
 
3A \t 2 \t 3 \t 2 \t 0,75 \t 78,67 \t 3,75 \t 3,25 \t 0,17 \t 0,83 \t 0,92 \t 9,67 \t 100,01 
 
3A \t 2 \t 8 \t 1,33 \t 0,33 \t 83,25 \t 3 \t 2,17 \t 0 \t 0,67 \t 0,83 \t 8,42 \t 100 
 
3B \t 1 \t 1 \t 35,5 \t 2,54 \t 29,33 \t 3,04 \t 1,88 \t 0,54 \t 7,46 \t 7,46 \t 12,25 \t 100 
 
3B \t 1 \t 3 \t 1,58 \t 0,67 \t 79,42 \t 4,58 \t 2,83 \t 0,42 \t 0,67 \t 2,75 \t 7,08 \t 100 
 
3B \t 1 \t 8 \t 0,83 \t 0,17 \t 88,83 \t 3,17 \t 2,83 \t 0,08 \t 0,42 \t 0,5 \t 3,17 \t 100 
 
3B \t 2 \t 1 \t 32,33 \t 1,75 \t 17,21 \t 4,5 \t 2,21 \t 0,42 \t 13,21 \t 4,96 \t 23,42 \t 100,01 
 
3B \t 2 \t 3 \t 2,5 \t 0,25 \t 67,58 \t 8,42 \t 4,25 \t 0,5 \t 1 \t 4,58 \t 10,92 \t 100 
 
3B \t 2 \t 8 \t 1 \t 0,08 \t 76,83 \t 6,25 \t 4,5 \t 0,08 \t 0,33 \t 3 \t 7,92 \t 99,99

Во-вторых, я превратил его в ширину в длинном формате с кодом ниже.

b <- reshape(a, 
     varying = c("Sint12", "Rev12", "c12", "t1pi", "t2pi", "t1i", "t2i", "IntWeak", "inc"), 
     v.names = "score", 
     timevar = "variable", 
     times = c("Sint12", "Rev12", "c12", "t1pi", "t2pi", "t1i", "t2i", "IntWeak", "inc"), 
     new.row.names = 1:1000, 
     direction = "long") 

И данные выглядят, как показано ниже после трансформации:

Exp. Gest lag Total variable score id 
 
1  1 1 1 100.00 Sint12 15.88 1 
 
2  1 1 3 100.00 Sint12 0.88 2 
 
3  1 1 8 100.00 Sint12 0.24 3 
 
4  1 2 1 100.00 Sint12 14.96 4 
 
5  1 2 3 100.00 Sint12 1.20 5 
 
6  1 2 8 100.00 Sint12 0.16 6 
 
7  2 1 1 100.00 Sint12 30.60 7 
 
8  2 1 3 100.00 Sint12 0.96 8 
 
9  2 1 8 100.00 Sint12 0.88 9 
 
10  2 2 1 100.00 Sint12 20.16 10 
 
11  2 2 3 100.00 Sint12 1.04 11 
 
12  2 2 8 100.00 Sint12 0.24 12 
 
13 3A 1 1 100.01 Sint12 35.83 13 
 
14 3A 1 3 99.99 Sint12 1.58 14 
 
15 3A 1 8 100.00 Sint12 1.00 15 
 
16 3A 2 1 100.02 Sint12 43.46 16 
 
17 3A 2 3 100.01 Sint12 2.00 17 
 
18 3A 2 8 100.00 Sint12 1.33 18 
 
19 3B 1 1 100.00 Sint12 35.50 19 
 
20 3B 1 3 100.00 Sint12 1.58 20 
 
21 3B 1 8 100.00 Sint12 0.83 21 
 
22 3B 2 1 100.01 Sint12 32.33 22 
 
23 3B 2 3 100.00 Sint12 2.50 23 
 
24 3B 2 8 99.99 Sint12 1.00 24

То, что я хочу; Первый. 4 графика (для каждого эксперимента), 2. составить график взаимодействия по Gest и лагом. третий; заполняйте стеки цветом переменной.

Для этого я использовал код, указанный ниже.

ggplot (данные = b, aes (x = взаимодействие (Gest, lag), y = оценка, fill = variable,)) + geom_bar (stat = "identity") + facet_wrap (~ Exp., Ncol = 2)

Plot

Теперь сюжет готов. Однако, когда я передаю аргумент position = dodge для geom_bar; это не работает. Я хотел бы иметь участок, где нет промежутка между 1.1 & 2.1; 1.3 & 2.3 и 1.8 & 2.8 (X осей этикеток). Кроме того, я хочу указать промежутки между .1-.3 и .8.

Заранее спасибо.

Answer 1

Что значит «это не работает»? Когда я добавил это, я получил сюжет, который правильно уклонился от баров.

Если вы просто хотели изменить интервал, вы можете сделать это, добавив дополнительные (пустые) уровни к коэффициенту, который строится вдоль x. Обратите внимание, что есть разное количество пробелов в каждом из дополнительных уровней:

ggplot(data=b 
     , aes(x= factor(interaction(Gest, lag) 
         , levels = c(1.1,2.1," ",1.3,2.3," ",1.8,2.8)) 
      ,y=score, fill = variable)) + 
    geom_bar(stat="identity", position = "dodge") + 
    facet_wrap(~Exp., ncol=2) + 
    scale_x_discrete(drop = FALSE) 

Вы можете пойти на несколько шагов вперед, если вы используете cowplot пакет. Здесь преимущество состоит в том, что вы можете сделать огранку в переменной lag, если вы производите каждую экспериментальную диаграмму отдельно. Затем вы можете сшить их вместе. Здесь я подавил отдельные легенды и добавил общую общую легенду внизу.

sepPlots <- lapply(unique(b$Exp.), function(thisExp){ 
    b %>% 
    filter(Exp. == thisExp) %>% 
    ggplot(aes(x = as.factor(Gest) 
       , y = score 
       , fill = variable)) + 
    geom_bar(stat="identity", position = "dodge") + 
    facet_wrap(~lag, nrow = 1 
       , labeller = label_both 
       , switch = "x") + 
    xlab("Gest") + 
    ggtitle(paste("Experiment:", thisExp)) 

}) 


expPlots <- 
    plot_grid(plotlist = lapply(sepPlots, function(x){x + guides(fill = "none")})) 

plot_grid(expPlots 
      , get_legend(sepPlots[[1]] + theme(legend.direction = "horizontal")) 
      , nrow = 2 
      , rel_heights = c(1, 0.1))