web-dev-qa-db-ja.com

R：x、y、zから3Dサーフェスをプロットする

私が3列のマトリックスを持っていると想像してください
x、y、zここで、zはxとyの関数です。

plot3d(x,y,z)を使用してこれらのポイントの「散布図」をプロットする方法を知っています。

しかし、代わりにサーフェスが必要な場合は、surface3dなどの他のコマンドを使用する必要があります。問題は、plot3dと同じ入力を受け入れないことです。

(nº elements of z) = (n of elements of x) * (n of elements of x)

このマトリックスを取得するにはどうすればよいですか？等高線図を使用する必要があるときに行うように、コマンドinterpを試しました。

この行列を計算せずに、x、y、zから直接サーフェスをプロットするにはどうすればよいですか？ポイントが多すぎる場合、このマトリックスは大きすぎます。

乾杯

r3dmatrixplotrgl
31
skan

X座標とY座標がグリッド上にない場合は、X、Y、Zサーフェスを1つに補間する必要があります。これは、geostatisticsパッケージ（geoR、gstat、その他）のいずれかを使用したクリギング、または逆距離重み付けなどの単純な手法を使用して行うことができます。

あなたが言及する「interp」関数はakimaパッケージのものであると推測しています。出力行列は、入力ポイントのサイズに依存しないことに注意してください。入力に10000個のポイントがあり、必要に応じてそれを10x10グリッドに補間できます。デフォルトでは、akima :: interpは40x40グリッドにそれを行います：

> require(akima) ; require(rgl)
> x=runif(1000)
> y=runif(1000)
> z=rnorm(1000)
> s=interp(x,y,z)
> dim(s$z)
[1] 40 40
> surface3d(s$x,s$y,s$z)

ランダムなデータのため、それはとがったように見えます。うまくいけば、あなたのデータはありません！

29
Spacedman

関数outer()を使用して生成できます。

関数persp()のデモをご覧ください。これは、表面の遠近法プロットを描画するための基本グラフィックス関数です。

最初の例を次に示します。

_x <- seq(-10, 10, length.out = 50)  
y <- x  
rotsinc <- function(x,y) {
    sinc <- function(x) { y <- sin(x)/x ; y[is.na(y)] <- 1; y }  
    10 * sinc( sqrt(x^2+y^2) )  
}

z <- outer(x, y, rotsinc)  
persp(x, y, z)
_

surface3d()にも同じことが当てはまります。

_require(rgl)  
surface3d(x, y, z)
_
6
Matthieu Dubois

Latticeの使用を見ることができます。この例では、z〜x、yをプロットするグリッドを定義しました。こんな感じです。ほとんどのコードは、ワイヤーフレーム関数を使用してプロットする3Dシェイプを作成するだけです。

変数「b」と「s」はxまたはyになります。

require(lattice)

# begin generating my 3D shape
b <- seq(from=0, to=20,by=0.5)
s <- seq(from=0, to=20,by=0.5)
payoff <- expand.grid(b=b,s=s)
payoff$payoff <- payoff$b - payoff$s
payoff$payoff[payoff$payoff < -1] <- -1
# end generating my 3D shape


wireframe(payoff ~ s * b, payoff, shade = TRUE, aspect = c(1, 1),
    light.source = c(10,10,10), main = "Study 1",
    scales = list(z.ticks=5,arrows=FALSE, col="black", font=10, tck=0.5),
    screen = list(z = 40, x = -75, y = 0))
6
Aaron Brown

rglは素晴らしいですが、軸を正しくするために少し実験をします。

多くのポイントがある場合は、それらからランダムなサンプルを取得して、結果のサーフェスをプロットしてください。同じデータのサンプルに基づいた複数のサーフェスを追加して、サンプリングのプロセスがデータに恐ろしい影響を与えているかどうかを確認できます。

だから、ここはかなり恐ろしい関数ですが、それはあなたがそれをやりたいと思うことをします（しかしサンプリングはしません）。マトリックス（x、y、z）が与えられた場合、zは高さで、ポイントと表面の両方をプロットします。制限は、各（x、y）ペアに対して1つのzしか存在できないことです。そのため、自分自身でループバックするプレーンは問題を引き起こします。

plot_points = Tは、表面が作られる個々のポイントをプロットします-これは、表面とポイントが実際に出会うことをチェックするのに役立ちます。 plot_contour = Tは、3Dビジュアライゼーションの下に2D等高線プロットをプロットします。色をRainbowに設定するときれいな色になり、他の色は灰色に設定されますが、関数を変更してカスタムパレットを与えることができます。とにかくこれは私のためのトリックを行いますが、私はそれを整理して最適化できると確信しています。 verbose = Tは、関数が壊れたときにデバッグするために使用する多くの出力を出力します。

plot_rgl_model_a <- function(fdata, plot_contour = T, plot_points = T, 
                             verbose = F, colour = "Rainbow", smoother = F){
  ## takes a model in long form, in the format
  ## 1st column x
  ## 2nd is y,
  ## 3rd is z (height)
  ## and draws an rgl model

  ## includes a contour plot below and plots the points in blue
  ## if these are set to TRUE

  # note that x has to be ascending, followed by y
  if (verbose) print(head(fdata))

  fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]
  if (verbose) print(head(fdata))
  ##
  require(reshape2)
  require(rgl)
  orig_names <- colnames(fdata)
  colnames(fdata) <- c("x", "y", "z")
  fdata <- as.data.frame(fdata)

  ## work out the min and max of x,y,z
  xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
  ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
  zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
  l <- list (x = xlimits, y = ylimits, z = zlimits)
  xyz <- do.call(expand.grid, l)
  if (verbose) print(xyz)
  x_boundaries <- xyz$x
  if (verbose) print(class(xyz$x))
  y_boundaries <- xyz$y
  if (verbose) print(class(xyz$y))
  z_boundaries <- xyz$z
  if (verbose) print(class(xyz$z))
  if (verbose) print(paste(x_boundaries, y_boundaries, z_boundaries, sep = ";"))

  # now turn fdata into a wide format for use with the rgl.surface
  fdata[, 2] <- as.character(fdata[, 2])
  fdata[, 3] <- as.character(fdata[, 3])
  #if (verbose) print(class(fdata[, 2]))
  wide_form <- dcast(fdata, y ~ x, value_var = "z")
  if (verbose) print(head(wide_form))
  wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])  
  if (verbose) print(wide_form_values)
  x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
  y_values <- as.numeric(wide_form[, 1])
  if (verbose) print(x_values)
  if (verbose) print(y_values)
  wide_form_values <- wide_form_values[order(y_values), order(x_values)]
  wide_form_values <- as.numeric(wide_form_values)
  x_values <- x_values[order(x_values)]
  y_values <- y_values[order(y_values)]
  if (verbose) print(x_values)
  if (verbose) print(y_values)

  if (verbose) print(dim(wide_form_values))
  if (verbose) print(length(x_values))
  if (verbose) print(length(y_values))

  zlim <- range(wide_form_values)
  if (verbose) print(zlim)
  zlen <- zlim[2] - zlim[1] + 1
  if (verbose) print(zlen)

  if (colour == "Rainbow"){
    colourut <- Rainbow(zlen, alpha = 0)
    if (verbose) print(colourut)
    col <- colourut[ wide_form_values - zlim[1] + 1]
    # if (verbose) print(col)
  } else {
    col <- "grey"
    if (verbose) print(table(col2))
  }


  open3d()
  plot3d(x_boundaries, y_boundaries, z_boundaries, 
         box = T, col = "black",  xlab = orig_names[1], 
         ylab = orig_names[2], zlab = orig_names[3])

  rgl.surface(z = x_values,  ## these are all different because
              x = y_values,  ## of the confusing way that 
              y = wide_form_values,  ## rgl.surface works! - y is the height!
              coords = c(2,3,1),
              color = col,
              alpha = 1.0,
              lit = F,
              smooth = smoother)

  if (plot_points){
    # plot points in red just to be on the safe side!
    points3d(fdata, col = "blue")
  }

  if (plot_contour){
    # plot the plane underneath
    flat_matrix <- wide_form_values
    if (verbose) print(flat_matrix)
    y_intercept <- (zlim[2] - zlim[1]) * (-2/3) # put the flat matrix 1/2 the distance below the lower height 
    flat_matrix[which(flat_matrix != y_intercept)] <- y_intercept
    if (verbose) print(flat_matrix)

    rgl.surface(z = x_values,  ## these are all different because
                x = y_values,  ## of the confusing way that 
                y = flat_matrix,  ## rgl.surface works! - y is the height!
                coords = c(2,3,1),
                color = col,
                alpha = 1.0,
                smooth = smoother)
  }
}

add_rgl_modelはオプションなしで同じジョブを実行しますが、既存の3dplotに表面をオーバーレイします。

add_rgl_model <- function(fdata){

  ## takes a model in long form, in the format
  ## 1st column x
  ## 2nd is y,
  ## 3rd is z (height)
  ## and draws an rgl model

  ##
  # note that x has to be ascending, followed by y
  print(head(fdata))

  fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]

  print(head(fdata))
  ##
  require(reshape2)
  require(rgl)
  orig_names <- colnames(fdata)

  #print(head(fdata))
  colnames(fdata) <- c("x", "y", "z")
  fdata <- as.data.frame(fdata)

  ## work out the min and max of x,y,z
  xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
  ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
  zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
  l <- list (x = xlimits, y = ylimits, z = zlimits)
  xyz <- do.call(expand.grid, l)
  #print(xyz)
  x_boundaries <- xyz$x
  #print(class(xyz$x))
  y_boundaries <- xyz$y
  #print(class(xyz$y))
  z_boundaries <- xyz$z
  #print(class(xyz$z))

  # now turn fdata into a wide format for use with the rgl.surface
  fdata[, 2] <- as.character(fdata[, 2])
  fdata[, 3] <- as.character(fdata[, 3])
  #print(class(fdata[, 2]))
  wide_form <- dcast(fdata, y ~ x, value_var = "z")
  print(head(wide_form))
  wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])  
  x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
  y_values <- as.numeric(wide_form[, 1])
  print(x_values)
  print(y_values)
  wide_form_values <- wide_form_values[order(y_values), order(x_values)]
  x_values <- x_values[order(x_values)]
  y_values <- y_values[order(y_values)]
  print(x_values)
  print(y_values)

  print(dim(wide_form_values))
  print(length(x_values))
  print(length(y_values))

  rgl.surface(z = x_values,  ## these are all different because
              x = y_values,  ## of the confusing way that 
              y = wide_form_values,  ## rgl.surface works!
              coords = c(2,3,1),
              alpha = .8)
  # plot points in red just to be on the safe side!
  points3d(fdata, col = "red")
}

だから私のアプローチは、あなたのすべてのデータでそれを試みることです（私は簡単に〜15kポイントから生成されたサーフェスをプロットします）。それでもうまくいかない場合は、いくつかの小さなサンプルを取り、これらの関数を使用して一度にすべてをプロットします。

5
Andrew

遅れているかもしれませんが、Spacedmanに続いて、duplicate = "strip"または他のオプションを試しましたか？

x=runif(1000)
y=runif(1000)
z=rnorm(1000)
s=interp(x,y,z,duplicate="strip")
surface3d(s$x,s$y,s$z,color="blue")
points3d(s)
3
Agustin