Цветовой код диаграммы рассеяния на основе другого значения - без ggplot

Question

Мне нужно построить несколько рассеивателей (x, y), но я бы хотел, чтобы точки были закодированы цветом на основе значения непрерывной переменной z.

Я бы хотел палитру температур (от темно-синего до ярко-красного). Я попытался с Rcolorbrewer, однако палитра RdBu (которая напоминает палитру температуры) использует белый для средних значений, что выглядит очень плохо.

Я также хотел бы нарисовать легенду, объясняющую цветовое кодирование, с образцом цветов и соответствующими значениями.

Какие-нибудь идеи, если это может быть легко выполнено в R? Нет ggplot, пожалуйста!

Привет всем!

Answer 1

Опираясь на ответ @ BenBolker, вы можете создать легенду, если взгляните на код filled.contour. Я взломал эту функцию отдельно, чтобы выглядеть так:

    scatter.fill <- function (x, y, z, 
                              nlevels = 20, plot.title, plot.axes, 
                              key.title, key.axes, asp = NA, xaxs = "i", 
                              yaxs = "i", las = 1, 
                              axes = TRUE, frame.plot = axes, ...) 
    {
        mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
        on.exit(par(par.orig))
        w <- (3 + mar.orig[2L]) * par("csi") * 2.54
        layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w)))
        par(las = las)
        mar <- mar.orig
        mar[4L] <- mar[2L]
        mar[2L] <- 1
        par(mar = mar)

        #Some simplified level/color picking
        levels <- seq(min(z),max(z),length.out = nlevels)
  col <- colorRampPalette(c("blue","red"))(nlevels)[rank(z)]

        plot.new()
        plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i", 
            yaxs = "i")
  rect(0, levels[-length(levels)], 1, levels[-1L], col = colorRampPalette(c("blue","red"))(nlevels)
        if (missing(key.axes)) {
            if (axes) 
                axis(4)
        }
        else key.axes
        box()
        if (!missing(key.title)) 
            key.title
        mar <- mar.orig
        mar[4L] <- 1
        par(mar = mar)

        #Simplified scatter plot construction
        plot(x,y,type = "n")
        points(x,y,col = col,...)

        if (missing(plot.axes)) {
            if (axes) {
                title(main = "", xlab = "", ylab = "")
                Axis(x, side = 1)
                Axis(y, side = 2)
            }
        }
        else plot.axes
        if (frame.plot) 
            box()
        if (missing(plot.title)) 
            title(...)
        else plot.title
        invisible()
    }

И затем, применяя код из примера Бена, мы получаем это:

x <- runif(40)
y <- runif(40)
z <- runif(40)
scatter.fill(x,y,z,nlevels = 40,pch = 20)

, который производит сюжет, подобный этому:

Справедливое предупреждение, я действительно взломал код для filled.contour. Вы, вероятно, захотите проверить оставшийся код и удалить неиспользуемые биты или исправить детали, которые я сделал неработоспособными.

Answer 2

Вот некоторый самодельный код для достижения этого с помощью пакетов по умолчанию (base, graphics, grDevices):

# Some data
x <- 1:1000
y <- rnorm(1000)
z <- 1:1000

# colorRamp produces custom palettes, but needs values between 0 and 1
colorFunction <- colorRamp(c("darkblue", "black", "red"))
zScaled <- (z - min(z)) / (max(z) - min(z))

# Apply colorRamp and switch to hexadecimal representation
zMatrix <- colorFunction(zScaled)
zColors <- rgb(zMatrix, maxColorValue=255)

# Let's plot
plot(x=x, y=y, col=zColors, pch="+")

Для StanLe вот соответствующая легенда (добавляется layout или чем-то подобным):

# Resolution of the legend
n <- 10

# colorRampPalette produces colors in the same way than colorRamp
plot(x=NA, y=NA, xlim=c(0,n), ylim=0:1, xaxt="n", yaxt="n", xlab="z", ylab="")
pal <- colorRampPalette(c("darkblue", "black", "red"))(n)
rect(xleft=0:(n-1), xright=1:n, ybottom=0, ytop=1, col=pal)

# Custom axis ticks (consider pretty() for an automated generation)
lab <- c(1, 500, 1000)
at <- (lab - min(z)) / (max(z) - min(z)) * n
axis(side=1, at=at, labels=lab)

Answer 3

Это разумное решение - я использовал синий, а не синий в качестве начальной точки, но вы можете проверить ?rgb и т. Д., Чтобы настроить цвет по своему вкусу.

nbrk <- 30
x <- runif(20)
y <- runif(20)
cc <- colorRampPalette(c("blue","red"))(nbrk)
z <- runif(20)
plot(x,y,col=cc[cut(z,nbrk)],pch=16)