ggplot2 - область тени над линией

Question

У меня есть некоторые данные, которые ограничены линией 1: 1. Я хотел бы продемонстрировать это на графике, слегка заштриховав область над линией, чтобы привлечь внимание зрителя к области под линией.

Я использую qplot для генерации графиков. Быстро у меня есть;

qplot(x,y)+geom_abline(slope=1)

но я не могу понять, как легко закрасить вышеуказанную область, не нанося отдельный объект. Есть ли простое решение для этого?

---

EDIT

Хорошо, Джоран, вот пример набора данных:

 df=data.frame(x=runif(6,-2,2),y=runif(6,-2,2),
   var1=rep(c("A","B"),3),var2=rep(c("C","D"),3))
 df_poly=data.frame(x=c(-Inf, Inf, -Inf),y=c(-Inf, Inf, Inf))

и вот код, который я использую для его построения (я принял ваш совет и искал ggplot()):

ggplot(df,aes(x,y,color=var1))+
 facet_wrap(~var2)+
 geom_abline(slope=1,intercept=0,lwd=0.5)+
 geom_point(size=3)+
 scale_color_manual(values=c("red","blue"))+
 geom_polygon(data=df_poly,aes(x,y),fill="blue",alpha=0.2)

Возникла ошибка: "объект 'var1' not found" Что-то подсказывает мне, что я неправильно реализую аргумент ...

Answer 1

Опираясь на ответ @ Andrie, мы предлагаем более (но не полностью) общее решение, которое в большинстве случаев обрабатывает затенение выше или ниже заданной строки.

Я не использовал метод, на который @Andrie ссылался здесь , поскольку столкнулся с проблемами, связанными с тенденцией ggplot автоматически расширять экстенты графика при добавлении точек вблизи краев. Вместо этого это создает точки многоугольника вручную, используя Inf и -Inf по мере необходимости. Несколько заметок:

• Точки должны быть в «правильном» порядке во фрейме данных, поскольку ggplot строит многоугольник в порядке появления точек. Поэтому недостаточно получить вершины многоугольника, они также должны быть упорядочены (по часовой стрелке или против часовой стрелки).

• В этом решении предполагается, что линия, которую вы строите, сама по себе не вызывает ggplot расширения диапазона графика. В моем примере вы увидите, что я выбираю линию для рисования, случайным образом выбирая две точки в данных и рисуя линию через них. Если вы попытаетесь нарисовать линию слишком далеко от остальных точек, ggplot автоматически изменит диапазоны графика, и станет трудно предсказать, какими они будут.

Во-первых, вот функция, которая строит фрейм данных полигона:

buildPoly <- function(xr, yr, slope = 1, intercept = 0, above = TRUE){
    #Assumes ggplot default of expand = c(0.05,0)
    xrTru <- xr + 0.05*diff(xr)*c(-1,1)
    yrTru <- yr + 0.05*diff(yr)*c(-1,1)

    #Find where the line crosses the plot edges
    yCross <- (yrTru - intercept) / slope
    xCross <- (slope * xrTru) + intercept

    #Build polygon by cases
    if (above & (slope >= 0)){
        rs <- data.frame(x=-Inf,y=Inf)
        if (xCross[1] < yrTru[1]){
            rs <- rbind(rs,c(-Inf,-Inf),c(yCross[1],-Inf))
        }
        else{
            rs <- rbind(rs,c(-Inf,xCross[1]))
        }
        if (xCross[2] < yrTru[2]){
            rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,Inf))
        }
        else{
            rs <- rbind(rs,c(yCross[2],Inf))
        }
    }
    if (!above & (slope >= 0)){
        rs <- data.frame(x= Inf,y= -Inf)
        if (xCross[1] > yrTru[1]){
            rs <- rbind(rs,c(-Inf,-Inf),c(-Inf,xCross[1]))
        }
        else{
            rs <- rbind(rs,c(yCross[1],-Inf))
        }
        if (xCross[2] > yrTru[2]){
            rs <- rbind(rs,c(yCross[2],Inf),c(Inf,Inf))
        }
        else{
            rs <- rbind(rs,c(Inf,xCross[2]))
        }
    }
    if (above & (slope < 0)){
        rs <- data.frame(x=Inf,y=Inf)
        if (xCross[1] < yrTru[2]){
            rs <- rbind(rs,c(-Inf,Inf),c(-Inf,xCross[1]))
        }
        else{
            rs <- rbind(rs,c(yCross[2],Inf))
        }
        if (xCross[2] < yrTru[1]){
            rs <- rbind(rs,c(yCross[1],-Inf),c(Inf,-Inf))
        }
        else{
            rs <- rbind(rs,c(Inf,xCross[2]))
        }
    }
    if (!above & (slope < 0)){
        rs <- data.frame(x= -Inf,y= -Inf)
        if (xCross[1] > yrTru[2]){
            rs <- rbind(rs,c(-Inf,Inf),c(yCross[2],Inf))
        }
        else{
            rs <- rbind(rs,c(-Inf,xCross[1]))
        }
        if (xCross[2] > yrTru[1]){
            rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,-Inf))
        }
        else{
            rs <- rbind(rs,c(yCross[1],-Inf))
        }
    }

    return(rs)
}

Он ожидает диапазоны x и y ваших данных (как в range()), наклон и точку пересечения линии, которую вы собираетесь построить, и хотите ли вы затенять выше или ниже линии. Вот код, который я использовал для генерации следующих четырех примеров:

#Generate some data
dat <- data.frame(x=runif(10),y=runif(10))

#Select two of the points to define the line
pts <- dat[sample(1:nrow(dat),size=2,replace=FALSE),]

#Slope and intercept of line through those points
sl <- diff(pts$y) / diff(pts$x)
int <- pts$y[1] - (sl*pts$x[1])

#Build the polygon
datPoly <- buildPoly(range(dat$x),range(dat$y),
            slope=sl,intercept=int,above=FALSE)

#Make the plot
p <- ggplot(dat,aes(x=x,y=y)) + 
        geom_point() + 
        geom_abline(slope=sl,intercept = int) +
        geom_polygon(data=datPoly,aes(x=x,y=y),alpha=0.2,fill="blue")
print(p)    

А вот несколько примеров результатов. Если вы найдете какие-либо ошибки, конечно, дайте мне знать, чтобы я мог обновить этот ответ ...

EDIT

Обновлено для иллюстрации решения на примере данных OP:

set.seed(1)
dat <- data.frame(x=runif(6,-2,2),y=runif(6,-2,2),
        var1=rep(c("A","B"),3),var2=rep(c("C","D"),3))
#Create polygon data frame
df_poly <- buildPoly(range(dat$x),range(dat$y))

ggplot(data=dat,aes(x,y)) + 
    facet_wrap(~var2) +
    geom_abline(slope=1,intercept=0,lwd=0.5)+
    geom_point(aes(colour=var1),size=3) + 
    scale_color_manual(values=c("red","blue"))+
    geom_polygon(data=df_poly,aes(x,y),fill="blue",alpha=0.2)

и это приводит к следующему выводу:

Answer 2

Насколько я знаю, нет другого пути, кроме создания многоугольника с альфа-смешанным заполнением.Например:

df <- data.frame(x=1, y=1)
df_poly <- data.frame(
    x=c(-Inf, Inf, -Inf),
    y=c(-Inf, Inf, Inf)
)

ggplot(df, aes(x, y)) + 
    geom_blank() + 
    geom_abline(slope=1, intercept=0) + 
    geom_polygon(data=df_poly, aes(x, y), fill="blue", alpha=0.2) +

Answer 3

На основании минимально модифицированной версии ответа @ joran :

library(ggplot2)
library(tidyr)
library(dplyr)

buildPoly <- function(slope, intercept, above, xr, yr){
  # By Joran Elias, @joran https://stackoverflow.com/a/6809174/1870254
  #Find where the line crosses the plot edges
  yCross <- (yr - intercept) / slope
  xCross <- (slope * xr) + intercept

  #Build polygon by cases
  if (above & (slope >= 0)){
    rs <- data.frame(x=-Inf,y=Inf)
    if (xCross[1] < yr[1]){
      rs <- rbind(rs,c(-Inf,-Inf),c(yCross[1],-Inf))
    }
    else{
      rs <- rbind(rs,c(-Inf,xCross[1]))
    }
    if (xCross[2] < yr[2]){
      rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,Inf))
    }
    else{
      rs <- rbind(rs,c(yCross[2],Inf))
    }
  }
  if (!above & (slope >= 0)){
    rs <- data.frame(x= Inf,y= -Inf)
    if (xCross[1] > yr[1]){
      rs <- rbind(rs,c(-Inf,-Inf),c(-Inf,xCross[1]))
    }
    else{
      rs <- rbind(rs,c(yCross[1],-Inf))
    }
    if (xCross[2] > yr[2]){
      rs <- rbind(rs,c(yCross[2],Inf),c(Inf,Inf))
    }
    else{
      rs <- rbind(rs,c(Inf,xCross[2]))
    }
  }
  if (above & (slope < 0)){
    rs <- data.frame(x=Inf,y=Inf)
    if (xCross[1] < yr[2]){
      rs <- rbind(rs,c(-Inf,Inf),c(-Inf,xCross[1]))
    }
    else{
      rs <- rbind(rs,c(yCross[2],Inf))
    }
    if (xCross[2] < yr[1]){
      rs <- rbind(rs,c(yCross[1],-Inf),c(Inf,-Inf))
    }
    else{
      rs <- rbind(rs,c(Inf,xCross[2]))
    }
  }
  if (!above & (slope < 0)){
    rs <- data.frame(x= -Inf,y= -Inf)
    if (xCross[1] > yr[2]){
      rs <- rbind(rs,c(-Inf,Inf),c(yCross[2],Inf))
    }
    else{
      rs <- rbind(rs,c(-Inf,xCross[1]))
    }
    if (xCross[2] > yr[1]){
      rs <- rbind(rs,c(Inf,xCross[2]),c(Inf,-Inf))
    }
    else{
      rs <- rbind(rs,c(yCross[1],-Inf))
    }
  }
  return(rs)
}

вы также можете расширить ggplot следующим образом:

GeomSection <- ggproto("GeomSection", GeomPolygon, 
  default_aes = list(fill="blue", size=0, alpha=0.2, colour=NA, linetype="dashed"), 
  required_aes = c("slope", "intercept", "above"),
  draw_panel = function(data, panel_params, coord) {
    ranges <- coord$backtransform_range(panel_params)
    data$group <- seq_len(nrow(data))
    data <- data %>% group_by_all %>% do(buildPoly(.$slope, .$intercept, .$above, ranges$x, ranges$y)) %>% unnest
    GeomPolygon$draw_panel(data, panel_params, coord)
    }
  )

geom_section <- function (mapping = NULL, data = NULL, ..., slope, intercept, above, 
          na.rm = FALSE, show.legend = NA) {
  if (missing(mapping) && missing(slope) && missing(intercept) && missing(above)) {
    slope <- 1
    intercept <- 0
    above <- TRUE
  }
  if (!missing(slope) || !missing(intercept)|| !missing(above)) {
    if (missing(slope)) 
      slope <- 1
    if (missing(intercept)) 
      intercept <- 0
    if (missing(above)) 
      above <- TRUE
    data <- data.frame(intercept = intercept, slope = slope, above=above)
    mapping <- aes(intercept = intercept, slope = slope, above=above)
    show.legend <- FALSE
  }
  layer(data = data, mapping = mapping, stat = StatIdentity, 
        geom = GeomSection, position = PositionIdentity, show.legend = show.legend, 
        inherit.aes = FALSE, params = list(na.rm = na.rm, ...))
}

Чтобы использовать его так же легко, как geom_abline:

set.seed(1)
dat <- data.frame(x=runif(6,-2,2),y=runif(6,-2,2),
                  var1=rep(c("A","B"),3),var2=rep(c("C","D"),3))

ggplot(data=dat,aes(x,y)) + 
  facet_wrap(~var2) +
  geom_abline(slope=1,intercept=0,lwd=0.5)+
  geom_point(aes(colour=var1),size=3) + 
  scale_color_manual(values=c("red","blue"))+
  geom_section(slope=1, intercept=0, above=TRUE)

Этот вариант имеет дополнительное преимущество, заключающееся в том, что он также работает с несколькимиуклоны и расширения пределов не по умолчанию.

ggplot(data=dat,aes(x,y)) +
  facet_wrap(~var2) +
  geom_abline(slope=1,intercept=0,lwd=0.5)+
  geom_point(aes(colour=var1),size=3) +
  scale_color_manual(values=c("red","blue"))+
  geom_section(data=data.frame(slope=c(-1,1), above=c(FALSE,TRUE), selected=c("selected","selected 2")), 
               aes(slope=slope, above=above, intercept=0, fill=selected), size=1) +
  expand_limits(x=3)