Добавление третьей переменной в график stat_density_2d

Question

Ниже приведен код и набор данных диаграммы stat_density_2d, которую я создал в R.

library(ggplot2)

topKzone <- 3.5
botKzone <- 1.6
inKzone <- -0.95
outKzone <- 0.95
kZone <- data.frame(
  x=c(inKzone, inKzone, outKzone, outKzone, inKzone),
  y=c(botKzone, topKzone, topKzone, botKzone, botKzone)
)

df$h <- round(df$platelocheight)
df$s <- round(df$platelocside)
df$es<- round(df$exitspeed)

ggplot(kZone, aes(x,y)) +
  stat_density_2d(data=df, aes(x=s, y=h),geom="polygon") +
  scale_fill_distiller(palette = "Spectral") +
  geom_path(lwd=1.5, col="black") +
  coord_fixed()

Данные:

structure(list(platelocheight = c(2.594, 3.803, 3.254, 3.599, 
    3.617, 3.297, 2.093, 3.611, 2.842, 3.316, 2.872, 3.228, 3.633, 
    4.28, 3.309, 2.8, 2.632, 3.754, 2.207, 3.604, 3.443, 2.188, 3.452, 
    2.553, 3.382, 3.067, 2.986, 2.785, 2.567, 3.804), platelocside = c(0.059, 
    -1.596, -0.65, -0.782, -0.301, -0.104, 0.057, -0.807, 0.003, 
    1.661, 0.088, -0.32, -1.115, -0.146, -0.364, -0.952, 0.254, 0.109, 
    -0.671, -0.803, -0.212, -0.069, -0.09, -0.472, 0.434, 0.337, 
    0.723, 0.508, -0.197, -0.635), exitspeed = c(69.891, 73.352, 
    83.942, 85.67, 79.454, 85.277, 81.078, 73.573, 77.272, 59.263, 
    97.343, 91.436, 76.264, 83.479, 47.576, 84.13, 60.475, 61.093, 
    84.54, 69.959, 88.729, 88.019, 82.18, 83.684, 86.296, 90.605, 
    79.945, 59.899, 62.522, 77.75)), .Names = c("platelocheight", 
    "platelocside", "exitspeed"), row.names = c(NA, 30L), class = "data.frame")

Код успешно выполняется, однако я хотел бы добавить третью переменную заполнения (exitspeed), чтобы она выглядела больше как тепловая карта. Я попытался добавить 'fill=es' в строку stat_density_2d, но код либо игнорирует строку 'fill=es', либо говорит, что не может найти переменную es.

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

Текущий код:

Что я хочу:

Примечание: я все еще хотел бы иметь шкалу в правой части графика.

Кто-нибудь знает, как правильно добавить третью переменную в график stat_density_2d? Я также открыт для использования других графиков / пакетов для построения этой тепловой карты. Заранее спасибо!

Answer 1

Есть две проблемы с вашим графиком:
- Во-первых, разные шкалы (единицы), как прокомментировано. Это делает невозможным просто создать второй stat_density для скорости, как я предложил в комментарии. Кроме того, fill =..density.. не будет работать в этом случае, потому что мы говорим о другой переменной.
- Во-вторых, грубые значения x/y (см. Ниже).

ggplot(kZone, aes(x,y)) +
  stat_density_2d(data=df, aes(x = s, y = h)) +
  geom_raster(data = df, aes(x = s, y = h, fill = exitspeed), interpolate = TRUE) 

#doesn't do the job, as the grid is to coarse

Проблема с грубыми координатами x/y состоит в том, что интерполяция не очень гладкая. Можно изменить параметры интерполяции, но я не знаю, как это сделать (пока). @JasonAizkalns задал этот вопрос в этом направлении - но, к сожалению, ответа пока нет.

Более точные координаты x/y определенно помогут. Так почему бы не предсказать их полу-вручную.

В основном вы хотите назначить значение скорости на выходе для каждой координаты x/y - в пределах вашего графика контура плотности! (Хотя я лично думаю, что это, вероятно, не имеет реального смысла, потому что эти вещи не обязательно связаны.)

Теперь - в следующем я буду предсказывать значение для случайной выборки x/y в пределах (!) Наибольшего многоугольника ваших контуров плотности из вашего исходного графика. Посмотрим:

require(fields) 
require(dplyr)
require(sp)

p <- ggplot_build(ggplot() +
                    stat_density_2d(data = df, aes(x = platelocside, y = platelocheight)) +
                    lims(x = c(-2,2), y = c(1,5)))$data[[1]] %>%
  filter(level == min(level))
#this one is a bit tricky: I increased the limits of the axis of the plot in order to get an 'entire' polygon. I then filtered the rows of the largest polygon (minimum level)

poly_object <- Polygon(cbind(p$x, p$y)) #create Spatial object from polygon coordinates
random_points <- apply(coordinates(spsample(poly_object,10000, type = 'random')),2, round, digits = 1) #(coordinates() pulls out x/y coordinates, I rounded because this unifies the coordinates, and then I sampled random points within this polygon)
tps_x <- cbind(df$platelocside, df$platelocheight) #matrix of independent values for Tps() function
tps_Y <- df$exitspeed      #dependent value for model prediction
fit <- Tps(tps_x, tps_Y)
predictedVal <- predict(fit, random_points) #predicting the exitspeed-values

ggplot() +
  geom_raster(aes(x = random_points[,'x'], y = random_points[,'y'], fill = predictedVal), interpolate = TRUE)+ 
  stat_density_2d(data = df, aes(x = platelocside, y = platelocheight)) +
geom_path(data = kZone, aes(x,y))