BRT: добавить цвета градиента к графикам взаимодействия, используя gbm.perspec

Question

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

Я использовал пример, представленный в пакете dismo:

library(dismo) 
data(Anguilla_train)
angaus.tc5.lr01 <- gbm.step(data=Anguilla_train, gbm.x = 3:13, gbm.y = 2,
family = "bernoulli", tree.complexity = 5, learning.rate = 0.01, 
bag.fraction = 0.5)

# Find interactions in the gbm model:
find.int <- gbm.interactions( angaus.tc5.lr01)
find.int$interactions
find.int$rank.list

Мне удалось добавить один и тот же цвет ко всему сюжету:

gbm.perspec( angaus.tc5.lr01, 7, 1,
            x.label = "USRainDays",
            y.label = "SegSumT", 
            z.label = "Fitted values",
            z.range=c(0,0.435),
            col="blue")

Или добавить цвет градиента, но не следуя установленным значениям:

    gbm.perspec( angaus.tc5.lr01, 7, 1,
             x.label = "USRainDays",
             y.label = "SegSumT", 
             z.label = "Fitted values",
             col=heat.colors(50),
             z.range=c(0,0.435))

Я также проверил код функции gbm.perspec, и если я правильно понял, подогнанные значения вызываются внутри формулы как "прогноз", а позже являются частью "pred.matrix", который передается в окончательное построение графика: persp(x = x.var, y = y.var, z = pred.matrix...), но мне не удалось получить к ним доступ из формулы gbm.perspec. Я попытался изменить функцию gbm.perpec, добавив "col=heat.colors(100)[round(pred.matrix*100, 0)]" в persp() внутри функции, но она не выполняет то, что я находясь в поиске:

persp(x = x.var, y = y.var, z = pred.matrix, zlim = z.range, 
      xlab = x.label, ylab = y.label, zlab = z.label, 
      theta = theta, phi = phi, r = sqrt(10), d = 3, 
      ticktype = ticktype,
      col=heat.colors(100)[round(pred.matrix*100, 0)], 
      mgp = c(4, 1, 0), ...)

Я полагаю, что решение может прийти от модификации функции gbm.perpec, знаете как?

Спасибо за ваше время!

Answer 1

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

Вот вариант использования пакета plot3Drgl, оригинальный код предоставлен @Fabrice.

library(dismo); library(plot3Drgl); library(devEMF)
data(Anguilla_train)
angaus.tc5.lr01 <- gbm.step(data=Anguilla_train, gbm.x = 3:13, gbm.y = 2,
                            family = "bernoulli", tree.complexity = 5, learning.rate = 0.01, 
                            bag.fraction = 0.5)

# Find interactions in the gbm model:
find.int <- gbm.interactions( angaus.tc5.lr01)
find.int$interactions
find.int$rank.list

d<-plot(angaus.tc5.lr01,c(1,7),return.grid=T)


x <- d$SegSumT
y <- d$USRainDays
z <- d$y


grid.lines = 30
elevation.site = loess(z ~ x*y, data=d, span=1, normalize = FALSE) 
x.pred <- seq(min(x), max(x), length.out = grid.lines) # x grid
y.pred <- seq(min(y), max(y), length.out = grid.lines) # y grid
xy <- expand.grid( x = x.pred, y = y.pred)  # final grid combined
z.site=matrix(predict(elevation.site, newdata = xy), nrow = grid.lines, ncol = grid.lines) # predicedt matrix

scatter3D(x, y, z, theta = 160, phi = 35, # x y z coords and angle of plot
          clab = c(""), # Needs moving - label legend
          colkey = list(side = 4, length = 0.65, 
                        adj.clab = 0.15, dist = -0.15, cex.clab = 0.6, cex.axis = 0.6), # change the location and length of legend, change position of label and legend
          clim = c(-4,0.1),
          bty = "b", # type of box
          col = ramp.col(col = c("grey", "blue"), 200),
          pch = 19, cex = 0.55, # shape and size of points
          xlab = "SegSumT", 
          xlim=c(10,20),ylim=c(0,3.5), zlim=c(-4,0.1), d= 2,
          ylab = "USRaindays",
          zlab= "Fitted values", #axes labels
          cex.lab = 0.8, font.lab = 1, cex.axis = 0.6, font.axis= 1, # size and font of axes and ticks
          ticktype = "detailed", nticks = 5, # ticks and numer of ticks
          #type = "h", # vertical lines
          surf = list(x = x.pred, y = y.pred, z = z.site,  
                      facets = NA, CI=NULL))

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

Изменяя grid.lines и переворачивая ось X, вы сможете создавать именно то, что вам нужно.

Answer 2

Включив часть кода, найденного здесь, вgbm.perspec() Исходный код позволяет создать желаемый эффект.

Первый забег

# Color palette (100 colors)
col.pal<-colorRampPalette(c("blue", "red"))
colors<-col.pal(100)

Затем добавьте z.facet.center к gbm.perspec() исходный код после else и изменить z в коде pred.matrixследующим образом,

# and finally plot the result
#
if (!perspective) {
  image(x = x.var, y = y.var, z = pred.matrix, zlim = z.range)
} else {
  z.facet.center <- (pred.matrix[-1, -1] + pred.matrix[-1, -ncol(pred.matrix)] + 
                       pred.matrix[-nrow(pred.matrix), -1] + pred.matrix[-nrow(pred.matrix), -ncol(pred.matrix)])/4
  # Range of the facet center on a 100-scale (number of colors)
  z.facet.range<-cut(z.facet.center, 100)
  persp(x=x.var, y=y.var, z=pred.matrix, zlim= z.range,      # input vars
        xlab = x.label, ylab = y.label, zlab = z.label,   # labels
        theta=theta, phi=phi, r = sqrt(10), d = 3,
        col=colors[z.facet.range],# viewing pars
        ticktype = ticktype, mgp = c(4,1,0), ...) #

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