绘制一个通用的表面和轮廓在研发

问题描述

我有以下数据

  var.asym＆LT;  - 函数（α1，α2，喜，β，N）{
  term11＆LT;  -  ALPHA1 *（1-α1）^（2 * XI-1）
  term12＆LT;  -  ALPHA1 *（1-α1）^（XI-1）*（1-α2）^喜
  TERM22＆LT;  - α2 *（1-α2）^（2 * XI-1）
  西格玛＆LT;​​  - 矩阵（C（term11，term12，term12，TERM22），nrow = 2，byrow = TRUE）
  西格玛*公测^ 2 / N
}

mop.jacob.inv＆LT;  - 函数（α1，α2，喜，β）{
  term11＆LT;  -  -qgpd（α1，喜，0，β）/喜 - β*（1-α1）^喜*日志（1-α1）/喜
  term12＆LT;  -  qgpd（α1，喜，0，β）/β
  TERM21＆LT;  -  -qgpd（α2，十一，0，β）/喜 - β*（1-α2）^喜*日志（1-α2）/喜
  TERM22＆LT;  -  qgpd（α2，十一，0，β）/β
  雅各＆LT;  - 矩阵（C（term11，term12，TERM21，TERM22），nrow = 2，byrow = TRUE）
  jacob.inv＆LT;  - 解决（雅各布）
  jacob.inv
}

var.asym2＆LT;  - 函数（α1，α2）var.asym（α1，α2，0.2，1，1000）
mop.jacob.inv2＆LT;  - 函数（α1，α2）mop.jacob.inv（α1，α2，0.2，1）
物体LT;  - 函数（α1，α2）{
  TERM1＆LT;  -  mop.jacob.inv2（α1，α2）％*％var.asym2（α1，α2）％*％T（mop.jacob.inv2（α1，α2））
  总和（诊断（字词1））
}

X  -  LT;  - 序列（0.01，0.98，通过= 0.01）
Y'LT;  - 序列（X [1] +0.01，0.99，通过= 0.01）
XY＆LT;  -  cbind（REP（X [1]，长度（X）），Y）

为（i的2：长度（X））{
  Y'LT;  - 序列（X [I] +0.01，0.99，通过= 0.01）
  的xy＆所述;  -  rbind（XY，cbind（代表（X [I]中，长度（x）的-i + 1），y））为
}

object.xy＆LT;  - 代表（0，4851）

对于（i的1：4851）{
  object.xy [1]  - ;  - 对象（XY [I，1]，XY [Ⅰ，2]）
}
 

现在我要绘制的表面（XY [，1]，XY [，2]，object.xy）。有没有办法这样做研究？我试过 persp 和轮廓的功能，但它似乎没有适合这种情况下，因为它们都需要增加序列x和y。 我想一个更普遍的问题是如何让等高线图，当我们给三胞胎（X，Y，Z）的序列。

解决方案

 库（dplyr）
库（tidyr）
库（magrittr）

long_data =
  data.frame（
    X = XY [1]％GT;％轮（2），
    Y = XY [2]％GT;％轮（2），
    Z = object.xy）

wide_data =
  long_data％＆GT;％
  US $ p $垫（X，Z）

Y = wide_data $ Y
wide_data％LT;＆GT;％选择（-y）
X =名称（wide_data）％＆GT;％as.numeric
Z = wide_data％＆GT;％as.matrix
persp（X，Y，Z）
轮廓（X，Y，Z）
 

说不上为什么轮帮助，但它确实。该整形必要建立从X，Y，Z轴数据的矩阵。注意，轮廓线聚结，因为在数据中的巨大窄峰成黑点。

I have the following data

var.asym <- function(alpha1, alpha2, xi, beta, n){
  term11 <- alpha1*(1-alpha1)^(2*xi-1)
  term12 <- alpha1*(1-alpha1)^(xi-1)*(1-alpha2)^xi
  term22 <- alpha2*(1-alpha2)^(2*xi-1)
  Sigma <- matrix(c(term11, term12, term12, term22), nrow=2, byrow=TRUE)
  Sigma*beta^2/n
}

mop.jacob.inv <- function(alpha1, alpha2, xi, beta){
  term11 <- -qgpd(alpha1, xi, 0, beta)/xi - beta*(1-alpha1)^xi*log(1-alpha1)/xi
  term12 <- qgpd(alpha1, xi, 0, beta)/beta
  term21 <- -qgpd(alpha2, xi, 0, beta)/xi - beta*(1-alpha2)^xi*log(1-alpha2)/xi
  term22 <- qgpd(alpha2, xi, 0, beta)/beta
  jacob <- matrix(c(term11, term12, term21, term22), nrow=2, byrow=TRUE)
  jacob.inv <- solve(jacob)
  jacob.inv
}

var.asym2 <- function(alpha1, alpha2) var.asym(alpha1, alpha2, 0.2, 1, 1000)
mop.jacob.inv2 <- function(alpha1, alpha2) mop.jacob.inv(alpha1, alpha2, 0.2, 1)
object <- function(alpha1, alpha2){
  term1 <- mop.jacob.inv2(alpha1, alpha2)%*%var.asym2(alpha1, alpha2)%*%t(mop.jacob.inv2(alpha1, alpha2))
  sum(diag(term1))
}

x <- seq(0.01, 0.98, by=0.01)
y <- seq(x[1]+0.01, 0.99, by=0.01)
xy <- cbind(rep(x[1], length(x)), y)

for(i in 2:length(x)){
  y <- seq(x[i]+0.01, 0.99, by=0.01)
  xy <- rbind(xy, cbind(rep(x[i], length(x)-i+1), y))
}

object.xy <- rep(0, 4851)

for(i in 1:4851){
  object.xy[i] <- object(xy[i, 1], xy[i, 2])
}

Now I want to plot a surface of (xy[, 1], xy[, 2], object.xy). Is there a way to do so in R? I tried persp and contour function but it did not seem to be appropriate for this case since they both require increasing sequences x and y. I guess a more general question would be how to make contour plot when we are given a sequence of triplets (x, y, z).

解决方案

library(dplyr)
library(tidyr)
library(magrittr)

long_data =
  data.frame(
    x = xy[,1] %>% round(2),
    y = xy[,2] %>% round(2),
    z = object.xy)

wide_data =
  long_data %>%
  spread(x, z)

y = wide_data$y
wide_data %<>% select(-y)
x = names(wide_data) %>% as.numeric
z = wide_data %>% as.matrix
persp(x, y, z)
contour(x, y, z)

Dunno why the round helps, but it does. The reshape was necessary to build a matrix from x, y, z data. Note that the contour lines coalesce into a black dot because of the huge narrow peak in the data.

这篇关于绘制一个通用的表面和轮廓在研发的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！