改变轴和镜像图以完成R中的非线性曲面

Question

我希望你能帮我解决这个问题，我一直在尝试不同的方法，但到目前为止没有任何效果：

我有一个在 x 轴上使用平方项 (x2) 的 3D 图形（值从 0 到 100）。原始 x 具有正值和负值（值从 -10 到 10）。在 x2 中，因此在我的 3D 图形的 X 轴中，值都是正的。认为x2=100是从x=-10^2和x=10^得到的值，x2=25来自x=-5^2和x=5^2等等。我只有 "half" 个图表，我想： 1) 在 X 轴上绘制原始比例从 -10 到 10 的图表。 2) 完成图表的另一半以具有非线性关系（即完成从 -10 到 0 对应的表面，我认为它应该是我现在拥有的那个的镜像）。

使用不同的颜色可以更好地看出非线性关系，但我没有在此处包括它们以简化代码。

由于无法将负值返回到绘图 x，因为平方根始终为正，因此我复制了 Excel 中的数据。我添加了负值（值现在从 -100 到 100），我再次制作了一个 R 列表。这不是一个解决方案，因为它仍然具有相同的 x2 比例，但无论如何它不起作用。

这是我绘制图表的方式：

数据：https://www.dropbox.com/s/fv943jf35eqtkd8/NSSH.csv?dl=0

link功能码：

logexp <- function(days = 1)
{
linkfun <- function(mu) qlogis(mu^(1/days))
linkinv <- function(eta) plogis(eta)^days
mu.eta <- function(eta) days * plogis(eta)^(days-1) *
  .Call("logit_mu_eta", eta, PACKAGE = "stats")
valideta <- function(eta) TRUE
link <- paste("logexp(", days, ")", sep="")
structure(list(linkfun = linkfun, linkinv = linkinv,
               mu.eta = mu.eta, valideta = valideta, name = link),
          class = "link-glm")
}

3D 图形：

library(akima)
x <- NSSH$reLDM
x2<- x^2
y <- NSSH$yr
y2 <-y^2
n <-NSSH$AgeDay1
z <- NSSH$survive
m <- glm(z~x2+y+y2+x2:y+n,family=binomial(link=logexp(NSSH$exposure)))

# interaction
i <- 25 
xtemp <- seq(min(x),max(x),length.out=i)
xrange <- rep(xtemp,times=i) 
x2temp <- seq(min(0),max(100),length.out=i)
x2range <- rep(x2temp,times=i) 
ytemp <- seq(min(y),max(y),length.out=i)
yrange <- rep(ytemp,each=i) 
y2temp <- seq(min(y2),max(y2),length.out=i)
y2range <- rep(y2temp,each=i)
ntemp <- rep(mean(n),times=i)
nrange <- rep(ntemp,times=i)

newdata <- data.frame(x2=x2range,y=yrange,y2=y2range,n=nrange)
zhat <- predict(m,newdata=newdata)
NS <- zhat^27
xyz <- interp(x2range,yrange,NS)


quartz()
persp(xyz,
      theta = 35, phi = 50,col="blue", border="grey40", ticktype = "detailed", zlim=c(0,1)) -> res2

有什么方法可以复制我拥有的 "half" 图作为“镜子”并将其放在我已有的部分旁边并使用 x 的原始比例？

非常感谢您的帮助！

更新：

3D图形完美！

但是当我使用 "half graph" 绘制等高线图时，它看起来像这样：

现在新图看起来像这样，我想知道为什么值 0.7 旁边的 0 附近的原点（红色圆圈中的区域）看起来与第一个等高线图不一样。你有什么主意吗？有可能修复它吗？再次感谢。

这是等值线图的代码：

image(xyz2,col = "white")
contour(xyz2,add=T)

Answer 1

我认为除了使 X 和 Y 增加并且 dim(Z) 是 c(length(X), length(Y)) 之外的小事情你不必担心。

xyz2 <- interp(sqrt(x2range), yrange, NS)   # change scale before interpolate
xyz2$x <- c(rev(xyz2$x)*-1, xyz2$x)         # reverse and combine
xyz2$x[41] <- 1.0E-8                    # because [40] = [41] = 0 (40 is interp's nx value)
xyz2$z <- rbind(apply(xyz2$z, 2, rev), xyz2$z) # reverse and combine

persp(xyz2,xlab="Relative laying date",ylab="Year",zlab="Nest success",
      theta = 35, phi = 50,col="blue", border="grey40", ticktype = "detailed")

[编辑]

我无法重现您的附加问题。

origin <- list(x = unique(x2range), 
               y = unique(yrange), 
               z = matrix(NS, ncol=length(unique(yrange))))

xyz <- interp(x2range,yrange,NS)                # OP's code

image(origin, col = "white", xlim=c(-10,10), ylim=c(7, 24))
contour(origin, add=T, lwd=1.5, drawlabels=F)                        # no interp : black
contour(xyz, add=T, col=2, drawlabels=F)                             # OP's code : red
contour(x=sqrt(xyz$x), y=xyz$y, z=xyz$z, add=T, col=3, drawlabels=F) # only scale change : green
contour(xyz2, add=T, col=4, drawlabels=F)                            # my code : blue

改变轴和镜像图以完成R中的非线性曲面

Change axis and mirror graph to complete non-linear surface in R

3d

r

surface