«interp» для дискретных точек для получения тепловой карты/контура R

Question

У меня есть выбор, в котором я генерирую данные из симуляции, а затем хотел бы построить график (график тепла/контур/3d-график и т. Д.); однако для них данные должны быть интерполированы с использованием таких функций, как interp. Вот пример dataset.

Вот кусок кода, который я попытался ...

library(akima) 
library(GA) # for persp3D; there exists another package for same function "fields" 

data <- read.table(commandArgs()[3], header=T,sep="\t") 
data <- na.omit(data) 

qmax = max(data$q) 
kmax = max(data$k) 

x <- data$k_bike/kmax 
y <- data$k_car/kmax 
z <- data$q/qmax 

matrix = interp(x,y,z) 

persp3D(matrix ,nlevels=30, asp=1, xlim=c(0,1), ylim=c(0,1), color.palette=colorRampPalette(c("green3","yellow", "red"),space = "rgb")) 

поэтому результат -

Теперь, благодаря интерполяции, существует много точек, которые имеют красный/оранжевый цвет вместо зеленого или около того. Для, например, если я использую levelplot из lattice

levelplot(z~x*y, xlim=c(0,1), ylim=c(0,1), col.regions=colorRampPalette(c("green3","yellow", "red"),space = "rgb")) 

Результатом является -

Теперь отчетливо видно, что существует очень мало точек данных, имеющих нулевой (или почти равна нулю) z значение. Теперь проблема в том, что с levelplot я получаю артефакты (белый цвет для отсутствующих точек данных), и я хотел бы иметь лучшую интерполяцию. Есть ли какая-нибудь другая функция для этого?

Я также попытался контурные графики следующим образом:

scale <- (qmax+10)/qmax * c(0.000, 0.01, 0.05, 0.10, 0.25, 0.5, 0.75, 1.0) 
filled.contour(matrix, nlevels=30, asp=1, xlim=c(0,1), ylim=c(0,1), levels=scale,color.palette=colorRampPalette(c("green3","yellow", "red"),space = "rgb")) 

и результат снова (вид неправильной цветовой индикацией).

Короче - Я хотел бы иметь контур участка или участка 3d, но с четким (или правильным) индикации цвета ноль (около нуля) z значение данных точки, аналогичных уровню сюжет.

Answer 1

Я подошел ваш вопрос с deldir и rgl пакеты (они позволяют планировавших поверхностей, определяемых нерегулярных наборов точек).

library(deldir); library(rgl) 

# Below two lines require time depending on the　machine power, be careful 
dxyz <- deldir(x, y, z = z)  # do Delaunay triangulation 
mxyz <- as.mesh3d(dxyz)   # convert it to triangle.mesh3d.obj 

bgyr <- colorRampPalette(c("blue", "green", "yellow", "red")) # colour func 

# use z values for colouring 
plot3d(mxyz, col=bgyr(256)[cut(mxyz$vb[3,], 256)][mxyz$it], type="shade") 
light3d()   # if you want vivit colours 

# another approach 
# you can solve it by just increasing interp()'s arguments, nx and ny. 

library(akima); library(lattice); library(dplyr) 

df <- interp(x,y,z, nx=150, ny=150) %>% interp2xyz() %>% data.frame() 
levelplot(z ~ x * y, df, xlim=c(0,1), ylim=c(0,1), 
      col.regions = colorRampPalette(c("green3", "yellow", "red"), space = "rgb"))