繁体   English   中英

轮廓-图解-升序

[英]Contour - Plot - Ascending order

我有一个包含位置(X,Y,高程)的矩阵。 我在称为“索引”的矩阵中添加一列。 我从矩阵创建X和Y向量。 它们都包括索引列。 然后,我按升序排序刚创建的X和Y向量。 然后,我构造一个包含高程的Z矩阵,并使用索引将其与位置相关联。 然后,我尝试使用命令轮廓(我想绘制轮廓图),但出现错误,提示X和Y应该升序...这是我刚刚做的! 我做错了什么?

noeud<-read.table("position.out")
Matrice_Noeud<-matrix(ncol = ncol(noeud), nrow=nrow(noeud))
for (i in 1:nrow(noeud)) {
  for (j in 1:ncol(noeud)) {
    Matrice_Noeud[i,j]<-noeud[i,j]
  }
}

Matrice_Noeud <- cbind(Matrice_Noeud, c(seq(1,nrow(noeud),1)))


x<-data.frame(x=Matrice_Noeud[,1],Index=Matrice_Noeud[,4])
y<-data.frame(y=Matrice_Noeud[,2],Index=Matrice_Noeud[,4])

X<-x[order(x$x),]
Y<-y[order(y$y),]


Z<-matrix(NA, ncol=nrow(noeud),nrow=nrow(noeud))
for (x_i in 1:nrow(noeud)) {
  for (y_i in 1:nrow(noeud)) {
    if (Y$Index[y_i]==X$Index[x_i]) {
      niveau<-which(Matrice_Noeud[,4]==Y$Index[y_i])
      Z[x_i,y_i]<-Matrice_Noeud[niveau,3]
    }


    }
  }

Xx<-array(X[,1])
Yy<-array(Y[,1])
Zz<-data.frame(Z)

contour(Xx,Yy,Zz)

好的,因为我已经开始这样做,所以我已经完成了。

#### making example data
## assumptions: length(unique(x))=19, length(unique(y))=12, nrow(data)=121
## (They mean the number of grid points is 19 * 12 = 228, but z.value is only 121.)
xyz.f <- function(m, n) - m + (n - 7)^2 + 16         # make z from x and y (it means nothing special)
xyz <- cbind( xyz <- expand.grid(x = round(seq(11,15,,19), 2), y = round(seq(6,10,,12), 2)),
               z = apply(xyz, 1, function(k) xyz.f(k[1], k[2])) )
set.seed(1); ind <- sample(19*12, 121)               # decide to use the 121 z of 19*12
noeud <- as.matrix(xyz[ind,])                        # example data maked out

#### making contour()'s arguments
Xx <- sort(unique(noeud[,1]))
Yy <- sort(unique(noeud[,2]))    # nrow(noeud); length(Xx); length(Yy)  # OK (121, 19, 12)

Zz <- matrix(NA, ncol=length(Yy), nrow=length(Xx))           # make 19 x 12 Z matrix (empty)
# In each row, calculate x (y) value is what number in Xx (Yy)  (= the position in Z matrix)
X0 <- as.numeric( factor( noeud[,1] ) )  # (edit) using Mr.Tufte's code in R help mailing.
Y0 <- as.numeric( factor( noeud[,2] ) ) 
apply(cbind(X0, Y0, noeud[,3]), 1, function (a) Zz[ a[1], a[2] ] <<- a[3])
## contour()'s arguments ( Xx, Yy, Zz ) maked out    
contour(Xx, Yy, Zz, xlab="including NAs")  # length(Zz); length(Zz[!is.na(Zz)]) # OK (228,121)

#### interpolating
## I know few packages having interpolation functions.
library(akima)                       # use cubic spline interpolation methods of H. Akima
NOEUD <- interp(noeud[,1], noeud[,2], noeud[,3])

#### results
par.old <- par(no.readonly=T); par(mfrow=c(1,3), mar=c(4,0,1,0))
contour(Xx, Yy, Zz, xlab="including NAs", yaxt="n")    # the including NAs data
contour(NOEUD, xlab="Akima interpolation", yaxt="n")   # the Akima interpolation data
contour(Xx, Yy, matrix(xyz[,3], nrow=19), xlab="origin", yaxt="n")  # the origin data
# (edit) I noticed some interp()'s arguments make a difference (default: linear=T, extrap=F).
contour(interp(noeud[,1], noeud[,2], noeud[,3], linear=T, extrap=F), xlab="Akima interp() default")
contour(interp(noeud[,1], noeud[,2], noeud[,3], linear=F, extrap=F), xlab="interp(linear=F)")
contour(interp(noeud[,1], noeud[,2], noeud[,3], linear=F, extrap=T), xlab="interp(linear=F, extrap=T)")
par(par.old)

### supplement (using the same data, output is about the same)
noeud2 <- data.frame(x=noeud[,1], y=noeud[,2], z=noeud[,3])      # equal to the including NAs data
NOEUD2 <- cbind(expand.grid(x=NOEUD$x, y=NOEUD$y), z=c(NOEUD$z)) # equal to the Akima interpolation data
ggplot2::ggplot( noeud2, aes( x, y, z = z )) + geom_contour()  
lattice::contourplot( z ~ x * y, NOEUD2 )

情节情节

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM