Изменить ось и зеркало график, чтобы завершить нелинейную поверхность в R

Question

Я надеюсь, что вы можете помочь мне решить эту проблему, я пытался разные вещи, но ничего до сих пор работы:

У меня есть 3D-график, использует квадрат (x2) по оси x (значения идут от 0 до 100). Исходный x имеет положительные и отрицательные значения (значения идут от -10 до 10). В x2 и, следовательно, на оси X моего 3D-графика все значения положительны. Думая, что x2 = 100 - это значение, полученное от x = -10^2 и x = 10 ^, x2 = 25 происходит от x = -5^2 и x = 5^2 и т. Д. У меня есть только «половина» графика, и я хотел бы: 1) У графика с исходным масштабом от -10 до 10 на оси X. 2) Завершите вторую половину графика, чтобы иметь нелинейную зависимость (т. Е. Заполнить поверхность, которая соответствует от -10 до 0, что, я полагаю, должно быть зеркалом того, что у меня есть сейчас).

Используя различные цвета, которые вы можете лучше видеть нелинейную зависимость, но я не включил их здесь для упрощения кода.

Поскольку вернуть отрицательные значения обратно в график x невозможно, потому что квадратный корень всегда будет положительным, я дублировал данные в Excel. Я добавил отрицательные значения (значения теперь идут от -100 до 100), я снова сделал список R. Это не решение, потому что оно по-прежнему имеет одинаковый масштаб x2, но в любом случае он не работает.

Это, как я построить график:

данных: https://www.dropbox.com/s/fv943jf35eqtkd8/NSSH.csv?dl=0

функция ссылка Код:

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 

Есть ли способ, которым я может скопировать «половинный» график, который у меня есть как «зеркало», и поставить его рядом с частью У меня уже есть и использовать исходную шкалу от x?

Большое спасибо за помощь!

UPDATE:

3D-график идеально!

Но когда я использую «половину графика», чтобы сделать контур участка он выглядит следующим образом:

И теперь с новым графиком он выглядит как это, интересно, почему происхождение около 0 рядом с значение 0,7 (площадь в красном круге) не выглядит так же, как первый график контура. Есть ли у вас какие-либо идеи? можно ли это исправить? Еще раз спасибо.

это код контура участка:

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