【问题标题】:Plot background colour in gradient在渐变中绘制背景颜色
【发布时间】:2015-05-09 06:18:35
【问题描述】:

此代码生成下面的第一个图:

water.height <- seq(0, 5, 1)
y <- seq(0, 1500, length.out = 6)
df <- data.frame(water.height, y)

library(ggplot2)
ggplot(df, aes(water.height, y)) + geom_blank()+ theme_bw()

我在这个蓝色背景中进行了 photoshop:

我可以用 R 代码生成相同的蓝色背景吗?

【问题讨论】:

  • 所以用这个渐变来给你的数据点着色是不够的?
  • 不,因为必须在 Photoshop 中执行操作会破坏再现性
  • 此链接可能:r.789695.n4.nabble.com/…

标签: r plot ggplot2


【解决方案1】:

在 cmets 中提供了指向 the ggplot2 approach 的相关链接。从那里复制:

library(grid) 
g <- rasterGrob(blues9, width=unit(1,"npc"), height = unit(1,"npc"), 
interpolate = TRUE) 
# grid.draw(g) 

library(ggplot2) 
ggplot(mtcars, aes(factor(cyl))) + # add gradient background 
   annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) + 
   geom_bar() # add data layer 

我自己的方法:

像往常一样,我无法与baptiste 解决网格图形问题的简单优雅方案相媲美,但这是我从事所有这些工作后的方法:

gg.background.fill <- function(gg.plot, cols = "white", which = "x") {
  #does not work with facets

  stopifnot(which %in% c("x", "y"))
  which1 <- if (which == "x") "width" else "height"

  require(gridExtra)

  g <- ggplotGrob(gg.plot)
  #g <- ggplotGrob(p)
  gg <- g$grobs      
  findIt <- vapply(gg, function(x) grepl("GRID.gTree", x$name, fixed = TRUE), TRUE)
  n1 <- getGrob(gg[findIt][[1]], "grill.gTree", grep=TRUE)$name
  n2 <- getGrob(gg[findIt][[1]], "panel.background.rect", grep=TRUE)$name
  gg[findIt][[1]]$children[[n1]]$children[[n2]]$gp$fill <- cols
  x <- gg[findIt][[1]]$children[[n1]]$children[[n2]][[which]]
  w <- gg[findIt][[1]]$children[[n1]]$children[[n2]][[which1]]
  attr <- attributes(x)
  x <- seq(0 + c(w)/length(cols)/2, 1 - c(w)/length(cols)/2, length.out = length(cols))
  attributes(x) <- attr
  gg[findIt][[1]]$children[[n1]]$children[[n2]][[which]] <- x
  w <- c(w)/length(cols) 
  attributes(w) <- attr
  gg[findIt][[1]]$children[[n1]]$children[[n2]][[which1]] <- w
  g$grobs <- gg
  class(g) = c("arrange", "ggplot", class(g)) 
  g
}
p1 <-  gg.background.fill(p, colorRampPalette(c("red", "blue"))(100))
print(p1)

p2 <-  gg.background.fill(p, colorRampPalette(c("red", "blue"))(100), "y")
print(p2)

这会修改现有的背景,这可能被认为是一种优势,但与annotation_custom 方法相比,它不适用于分面。这需要做更多的工作。

【讨论】:

  • 有没有办法在对角线上做到这一点?这样红色是左下角,蓝色是右上角?
【解决方案2】:

我们想使用线性渐变作为绘图的背景。

让我们先创建一个数字介于 0 和 1 之间的矩阵。

# The angle of our linear gradient
deg <- 45
rad <- deg / (180 / pi)

# A 5x5 matrix
n   <- 5
mat <- matrix(data = 0, ncol = n, nrow = n)

# Let's fill in the matrix.
for (i in 1:n) {
  for (j in 1:n) {
    mat[i, j] <- (i / n) * cos(rad) + (j / n) * sin(rad)
  }
}

我们得到了什么?

mat
#>           [,1]      [,2]      [,3]      [,4]      [,5]
#> [1,] 0.2828427 0.4242641 0.5656854 0.7071068 0.8485281
#> [2,] 0.4242641 0.5656854 0.7071068 0.8485281 0.9899495
#> [3,] 0.5656854 0.7071068 0.8485281 0.9899495 1.1313708
#> [4,] 0.7071068 0.8485281 0.9899495 1.1313708 1.2727922
#> [5,] 0.8485281 0.9899495 1.1313708 1.2727922 1.4142136

这看起来非常接近我们想要的。

现在,让我们将值限制在 0 和 1 之间。

mat <- mat - min(mat)
mat <- mat / max(mat)
mat
#>       [,1]  [,2]  [,3]  [,4]  [,5]
#> [1,] 0.000 0.125 0.250 0.375 0.500
#> [2,] 0.125 0.250 0.375 0.500 0.625
#> [3,] 0.250 0.375 0.500 0.625 0.750
#> [4,] 0.375 0.500 0.625 0.750 0.875
#> [5,] 0.500 0.625 0.750 0.875 1.000

好多了!

让我们使用grid::rasterGrob() 来制作一个图形对象,然后 画出来。

library(grid)
g <- rasterGrob(
  image = mat,
  width = unit(1, "npc"),
  height = unit(1, "npc"), 
  interpolate = TRUE
)
grid.newpage()
grid.draw(g)

因为我们有一个 grob,我们可以将它添加到一个 ggplot2 图形中 ggplot2::annotation_custom().

library(ggplot2)

ggplot(mtcars, aes(factor(cyl))) +
  annotation_custom(
    grob = g, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf
  ) + 
  geom_bar()

万岁!我们做到了。但我们还没有完成。

几点说明:

  • 最好有一个接受几个参数的函数:
    • 角度
    • 分辨率
    • 要使用的颜色
  • 我们上面的代码很容易阅读,但执行起来很慢。我们需要 更快。

请随意复制下面的make_gradient()函数并 改进它。

library(ggplot2) 
library(grid)
library(RColorBrewer)

make_gradient <- function(deg = 45, n = 100, cols = blues9) {
  cols <- colorRampPalette(cols)(n + 1)
  rad <- deg / (180 / pi)
  mat <- matrix(
    data = rep(seq(0, 1, length.out = n) * cos(rad), n),
    byrow = TRUE,
    ncol = n
  ) +
  matrix(
    data = rep(seq(0, 1, length.out = n) * sin(rad), n),
    byrow = FALSE,
    ncol = n
  )
  mat <- mat - min(mat)
  mat <- mat / max(mat)
  mat <- 1 + mat * n
  mat <- matrix(data = cols[round(mat)], ncol = n)
  grid::rasterGrob(
    image = mat,
    width = unit(1, "npc"),
    height = unit(1, "npc"), 
    interpolate = TRUE
  )
}

示例 1

g <- make_gradient(
  deg = 45, n = 500, cols = brewer.pal(9, "Spectral")
)

ggplot(mtcars, aes(factor(cyl))) +
  annotation_custom(
    grob = g, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf
  ) + 
  geom_bar()

示例 2

g <- make_gradient(
  deg = 180, n = 500, cols = brewer.pal(9, "RdBu")
)

ggplot(mtcars, aes(factor(cyl))) +
  annotation_custom(
    grob = g, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf
  ) + 
  geom_bar()

reprex package (v0.2.1) 于 2019 年 2 月 6 日创建

【讨论】:

    【解决方案3】:

    我使用 Kamil Slowikowski 的示例构建了一个更简单的函数,该函数根据一系列值生成线性渐变。如果您在三个变量之间存在某种关系(例如y~x*z,其中z 也随x 而变化),这可能会很有用。然后你只需绘制y~x 并将z~x 作为背景中的颜色渐变。

    water.height <- seq(0, 5, 1)
    y <- seq(0, 1500, length.out = 6)
    z <- rnorm(6, 10, 1)
    df <- data.frame(water.height, y, z)
    
    grad_by_val <- function(x, y, cols = blues9) {
      require(grid)
      y <- y[order(x)]
      ys <- (y - min(y)) / diff(range(y))
      cols <- colorRamp(cols)(ys) / 256
      colnames(cols) <- c("red", "green", "blue")
      cols <- apply(cols, 1, function(z) do.call(rgb, as.list(z)))
      mat <- matrix(cols, ncol = length(x))
      rasterGrob(
        image = mat,
        width = unit(1, "npc"),
        height = unit(1, "npc"),
        interpolate = TRUE
      )
    }
    
    library(ggplot2)
    ggplot(df, aes(water.height, y)) + geom_blank() + theme_bw() +
      annotation_custom(
        grob = grad_by_val(df$water.height, df$z),
        xmin = -Inf,
        xmax = Inf,
        ymin = -Inf,
        ymax = Inf
      ) +
      geom_point(
        size = 5,
        color = "#FFFFFF",
        fill = "#000000",
        shape = 21
      )
    

    要添加图例,请参阅here

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2020-07-04
      • 2022-12-21
      • 1970-01-01
      • 1970-01-01
      • 2018-11-25
      • 2012-03-15
      • 1970-01-01
      • 2012-07-10
      相关资源
      最近更新 更多