如何在R中重新创建这个2d曲面+轮廓+字形图？

Question

我在一些建模软件中运行了2d模拟，我从中获得了带有一组6个属性的x，y点位置的导出。我希望重新创建一个结合数据的数字，如下所示：

椭圆和背景根据属性1着色（并且这些边框当然代表模型几何，但我认为我不能复制它），等值线是属性2的轮廓，并且箭头字形来自属性3（x幅度）和4（y幅度）。

我认为x，y点是三角网格的中心，看起来像这样：

我想知道如何用R重新创建这样的图。首先，我有不规则间隔的数据，因为它是从不规则网格导出的。这就是我被R困住的地方，只是用它来制作盒子和耳语等等。

这是数据： https://dl.dropbox.com/u/22417033/Ellipses_noheader.txt
编辑：字段：x，y，热通量（x），热通量（y），热导率，温度，gradT（x），gradT（y）。

names(Ellipses) <- c('x','y','dfluxx','dfluxy','kxx','Temps','gradTx','gradTy')

Answer 1

制作较低的图很容易（假设有一个名为'edat'的数据框用：

 edat <- read.table(file=file.choose())
 with(edat, plot(V1,V2), cex=0.2)

事情变得更加美丽：

with(edat, plot(V1,V2, cex=0.2, col=V5))

所以我不认为您的原件是由数据忠实代表的。轮廓线不是直线穿过“导体”。我把它们称为“导体”，因为这看起来有点像静电中的等势线。

然后，您可以使用以下内容覆盖矢量字段：

with(edat, arrows(V1,V2, V1-20*V6*V7, V2-20*V6*V8, length=0.04, col="orange") )

您可以使用xlim和ylim“放大”：

with(edat, plot(V1,V2, cex=0.3, col=V5, xlim=c(0, 10000), ylim=c(-8000, -2000) ))
with(edat, arrows(V1,V2, V1-20*V6*V7, V2-20*V6*V8, length=0.04, col="orange") )

猜测轮廓是否为Temps变量请求。选择等高线图。

require(akima)
intflow<- with(edat, interp(x=x, y=y, z=Temps, xo=seq(min(x), max(x), length = 410), 
              yo=seq(min(y), max(y), length = 410), duplicate="mean", linear=FALSE) )

require(lattice)
contourplot(intflow$z)
filled.contour(intflow)
with( intflow, contour(x=x, y=y, z=z) )

最后一个将与其他绘图示例混合，因为那些使用基本绘图功能。您可能需要切换为points而不是plot。

Answer 2

你的情节有几个部分，所以你可能需要几个工具来制作不同的部分。

可以使用polygon创建背景和省略号（一旦你知道它们应该在哪里）。

contourLines函数可以为您计算轮廓线，您可以使用lines函数（或contour具有add参数添加该轮廓线，并且可能用于直接添加行。）

akima包有一个函数interp，它可以在未给定值的情况下估计网格上的值。

来自TeachingDemos包的my.symbols函数和ms.arrows可用于绘制矢量字段。

Answer 3

@DWin说你的图表并不忠实地代表你的数据是正确的，所以我建议你回答他的问题。然而，这里是如何重现（我最接近）您的图表：

Ellipses <- read.table(file.choose())
names(Ellipses) <- c('x','y','dfluxx','dfluxy','kxx','Temps','gradTx','gradTy')
require(splancs)
require(akima)

首先准备数据：

#First the background layer (the 'kxx' layer):
# Here the regular grid on which we're gonna do the interpolation
E.grid <- with(Ellipses, 
               expand.grid(seq(min(x),max(x),length=200),
                           seq(min(y),max(y),length=200)))
names(E.grid) <- c("x","y") # Without this step, function inout throws an error
E.grid$Value <- rep(0,nrow(E.grid))
#Split the dataset according to unique values of kxx
E.k <- split(Ellipses,Ellipses$kxx)
# Find the convex hull delimiting each of those values domain
E.k.ch <- lapply(E.k,function(X){X[chull(X$x,X$y),]}) 
for(i in unique(Ellipses$kxx)){ # Pick the value for each coordinate in our regular grid
    E.grid$Value[inout(E.grid[,1:2],E.k.ch[names(E.k.ch)==i][[1]],bound=TRUE)]<-i
}

# Then the regular grid for the second layer (Temp)
T.grid <- with(Ellipses,
               interp(x,y,Temps, xo=seq(min(x),max(x),length=200),        
                      yo=seq(min(y),max(y),length=200), 
                      duplicate="mean", linear=FALSE))
# The regular grids for the arrow layer (gradT)
dx <- with(Ellipses,
           interp(x,y,gradTx,xo=seq(min(x),max(x),length=15),
                  yo=seq(min(y),max(y),length=10),
                  duplicate="mean", linear=FALSE))
dy <- with(Ellipses,
           interp(x,y,gradTy,xo=seq(min(x),max(x),length=15),
                  yo=seq(min(y),max(y),length=10),
                  duplicate="mean", linear=FALSE))
T.grid2 <- with(Ellipses,
               interp(x,y,Temps, xo=seq(min(x),max(x),length=15),        
                      yo=seq(min(y),max(y),length=10), 
                      duplicate="mean", linear=FALSE))
gradTgrid<-expand.grid(dx$x,dx$y)

然后绘图：

palette(grey(seq(0.5,0.9,length=5)))
par(mar=rep(0,4))
plot(E.grid$x, E.grid$y, col=E.grid$Value, 
     axes=F, xaxs="i", yaxs="i", pch=19)
contour(T.grid, add=TRUE, col=colorRampPalette(c("blue","red"))(15), drawlabels=FALSE)
arrows(gradTgrid[,1], gradTgrid[,2],  # Here I multiply the values so you can see them
       gradTgrid[,1]-dx$z*40*T.grid2$z, gradTgrid[,2]-dy$z*40*T.grid2$z, 
       col="yellow", length=0.05)

为了详细了解此代码的工作原理，建议您阅读以下帮助页面：?inout，?chull，?interp，?expand.grid和{{1} }。