добавить график (subplot) и несколько стандартных отклонений в ggplot () с фильтрацией на основе условий в R

Question

Часть 1: Мы пытаемся создать ggplot(), который показывает несколько различных сводных статистических данных в зависимости от оси x. Нам более или менее удалось это сделать, но мы открыты для предложений по повышению эффективности.

1. Для Time 0: диапазон погрешностей ограничен от 6 г до 20 g
2. Для Time от 1 до 8: среднее +/- 1 стандартное отклонение (SD)
3. Для Time от 9 до 12: среднее +/- 2 SD
4. Для Time> 13: нет полос ошибок

Часть 2: Данные, над которыми мы фактически работаем, имеют Times до 3000. Из-за этого мы бы хотелось бы включить вставку (subplot) в верхнюю левую часть графика для Time>=6, Time<=10.

Часть 3: В дополнение к обоим вышесказанным мы хотим затем удалите все точки данных, которые находятся за пределами полос ошибок (чтобы мы могли показать график «до» (со всеми точками, включая те, что находятся за пределами полос ошибок) и «после» (только точки внутри границ ошибки) столбцы до Time==12)) включительно.

В целях воспроизводимости я использую набор данных из R, чтобы проиллюстрировать свой вопрос. Набор данных:

library(datasets)
data(ChickWeight) #importing data from base R
summary(ChickWeight)

 weight           Time           Chick         Diet   
 Min.   : 35.0   Min.   : 0.00   13     : 12   1:220  
 1st Qu.: 63.0   1st Qu.: 4.00   9      : 12   2:120  
 Median :103.0   Median :10.00   20     : 12   3:120  
 Mean   :121.8   Mean   :10.72   10     : 12   4:118  
 3rd Qu.:163.8   3rd Qu.:16.00   17     : 12          
 Max.   :373.0   Max.   :21.00   19     : 12          
                                 (Other):506 

Мне удалось кое-что из этого сделать, сначала создав векторы (по одному для ymin и ymax в geom_errorbar). Код для этого находится в конце вопроса. Мы открыты для предложений о том, как сделать это более эффективно.

Затем мы пытаемся собрать все это вместе ggplot() вот так (исключая ненужное форматирование):

#Import required package: 
library(ggplot2)
    
ggplot(merge_stats, aes(y = weight, x = as.numeric(Time))) +
    geom_jitter(color="grey", width=0.1)+
    geom_errorbar(aes(ymin=SDbelow, ymax=SDabove), width=0.1, size=1)+
    stat_summary(
      geom = "point",
      fun.y = "mean",
      col = "blue",
      size = 2,
      shape = 19,
      fill = "blue")

Это генерирует:

введите описание изображения здесь

Как нам добавить subplot() к этому ggplot()? И Как нам затем go удалить точек за пределами параметров стандартного отклонения, установленных выше?

Итак, конечный продукт должен состоять из двух фигур, одного графика и подзаголовка со всеми точками данных, а также другого графика и подзаголовка без удаленных точек.

Код для получения различных стандартных отклонений для каждой возрастной группы. Обратите внимание: мы открыты для предложений по оптимизации.

#loading required package
library(dplyr)
library(pracma)

#Creates a table that includes the SD of each age and the mean of each age 
merge_stats <- ChickWeight %>% 
    arrange(Time) %>% 
    group_by(Time) %>%
    mutate(MEAN=mean(weight), SD = sd(weight), SDt=2*sd(weight)) #add to data 

#Vector for Time==0:      
merge_stats_age_zero <- merge_stats %>%  
    filter(Time==0)
vl <-  length(merge_stats_age_zero$weight)
MSZUL=linspace(20, 20, vl) #Vector for top bound 
MSZLL=linspace(6, 6, vl)   #Vector for bottom bound 

#Vector for Time>=1, Time<=8:
mergesaot <- merge_stats %>%                  
    filter(Time>=1, Time<=8)

#vectors for +/- 1 SD for Time>=1, Time<=8:
otoerr = mergesaot$MEAN+mergesaot$SD
otberr = mergesaot$MEAN-mergesaot$SD

#Vector for Time>8, Time<=12:
mergesef <- merge_stats %>%                   
    filter(Time>8) %>%
    filter(Time<=12)

#vectors for +/- 2 SD for Time>8, Time<=12:
efoerr <- mergesef$MEAN+mergesef$SDt
efberr <- mergesef$MEAN-mergesef$SDt

#Combining vectors together:
LSDabove <- c(MSZUL ,otoerr, efoerr)
LSDbelow <- c(MSZLL ,otberr, efberr)

#To generate the final vector we need to first find its length. This is done by subtracting the length of the total by the three added together.
m_swt <- c(merge_stats$SD)
finpeice <- length(m_swt) - length(LSDabove)

#Knowing the length we will generate a vector of zeros to represent no error bars and to cover the remaining length of our errorbar vectors 
finpeiceVec <- linspace(0, 0, finpeice) 

#Finaly we have generated our two vectors to represent our error bars
SDabove <- c(MSZUL ,otoerr, efoerr, finpeiceVec)
SDbelow <- c(MSZLL ,otberr, efberr, finpeiceVec)

Answer 1

Это действительно два вопроса. Вопрос об удалении точек за пределами полос ошибок на самом деле сводится к фильтрации ваших данных после создания сводной статистики для основного набора данных. Если вы боретесь с этим, возможно, лучше задать специальный вопрос. Я покажу здесь, как вставить подзаговор с использованием grid, на котором построено ggplot2:

subset1 <- which(merge_stats$Time >= 6 & merge_stats$Time <= 10)

p1 <- ggplot(merge_stats[subset1, ], 
             aes(y = weight, x = as.numeric(Time))) +
  geom_jitter(color="grey", width=0.1)+
  geom_errorbar(aes(ymin=SDbelow[subset1], ymax=SDabove[subset1]), width=0.1, size=1)+
  stat_summary(
    geom = "point",
    fun.y = "mean",
    col = "blue",
    size = 2,
    shape = 19,
    fill = "blue")

inset <- ggplotGrob(p1)

ggplot(merge_stats, aes(y = weight, x = as.numeric(Time))) +
  geom_jitter(color="grey", width=0.1)+
  geom_errorbar(aes(ymin=SDbelow, ymax=SDabove), width=0.1, size=1)+
  stat_summary(
    geom = "point",
    fun.y = "mean",
    col = "blue",
    size = 2,
    shape = 19,
    fill = "blue")

vp <- grid::viewport(width = 0.4, height = 0.4, x = 0.3, y = 0.7)

print(p1, vp = vp)

введите описание изображения здесь