将许多不等式绘制为平面
Plotting a number of inequalities as planes
我想绘制多个平面,每个平面都是一个不等式。在我绘制完所有平面后,我想将它们组合起来,并为这些线内的区域着色。绘制大量 3d 线并为内部区域着色的图像 - 这就是我想要做的。
我的数据是这样的:
df <- structure(list(z = c(0, 0.06518, 0.08429, -0.01659, 0, 0.06808,
0.12383, -1, -0.01662, 0.28782, 0, -0.09539, 0.04255, 0.09539,
-0.13361, -0.28782, -0.14468, -0.19239, 0.10642), x = c(1, 0.02197,
0.03503, -0.02494, 0, 0.04138, 0.17992, 0, -0.02482, 0.1122,
0, 0.01511, 0.0011, -0.01511, -0.06699, -0.1122, -0.06876, 0.12078,
0.10201), y = c(0, 0.08735, 0.09927, 0.03876, -1, 0.22114, -0.00152,
0, 0.03811, -0.07335, 0, -0.03025, 0.07681, 0.03025, -0.23922,
0.07335, -0.25362, -0.09879, 0.05804), value = c(5801L, 135L,
162L, 109L, 4250L, 655L, 983L, 4500L, 108L, 1594L, 4400L, 540L,
147L, 323L, 899L, 1023L, 938L, 1627L, 327L)), .Names = c("z",
"x", "y", "value"), class = "data.frame", row.names = c(NA, -19L
))
每一行代表一个方程式:z + x + y < value
。 x
是水平值,y
是垂直值,z
是深度。 z 可以求解为:-x - y + value > z。
坐标系的范围是:
x <- z <- seq(-6000, 6000, by = 1)
y <- seq(-4000, 4000, by = 1)
所以,我想从每一行画一个平面。然后我想结合所有这些平面,并填写线条内的值。结果应该看起来像一个多边不等骰子。或者一颗切工丑陋的钻石。
我一直在研究 rgl
和 persp
函数,但我不确定从哪里开始。我愿意接受其他软件推荐。
参考 persp3d
中的示例之一:
x <- seq(-6000, 6000, by = 1)
z <- x
y <- seq(-4000, 4000, by = 1)
f <- function(x, y) <- { r <- -x - y + value > z } # stuck here, can you handle an inequality here?
z <- outer(x, y, f)
open3d()
bg3d("white")
material3d(col = "black")
persp3d(x, y, z, col = "lightblue",
xlab = "X", ylab = "Y", zlab = "z")
我承认这是相当大的限制。如果它有助于减少它们,请随意,或增加 sequence(..., by = )
。
您可以创建一个接受 data.frame 不等式 (df
) 的函数工厂,以及 returns 一个函数:
- 取三个值(x、y、z)
- Returns 如果加载的任何不等式不成立则为 false
工厂:
eval_gen <- function(a,b,c,d){
force(a); force(b); force(c); force(d)
check <- function(x,y,z){
bool <- T
for (i in 1:length(a)){
bool <- bool && (a[i] * x + b[i] * y + c[i] * z < d[i])
}
return(bool)
}
}
然后我们加载不平等数据框,创建函数:
ueq_test <- eval_gen(df$x,df$y,df$z,df$value) #load the inequalities
现在我们需要做的就是创建一个网格,如果所有不等式都成立,就填上颜色:
library(data.table)
library(rgl)
#Note, you can change the resolution by changing the `by` argument here, I've set to 100 to keep computation time and object size manageable
lx <- lz <- seq(-6000, 6000, by = 100)
ly <- seq(-4000, 4000, by = 100)
df_pixels <- data.table(setNames(expand.grid(lx, ly, lz), c("x", "y", "z")))
df_pixels[, Ind := 1:.N]
df_pixels[, Equal := ueq_test(x,y,z), by = Ind]
df_pixels[Equal == T, colour := "red"]
绘图到 rgl:
with(df_pixels[Equal == T, ], plot3d(x=x, y=y, z=z, col= colour, type="p", size=5,
xlim = c(-6000,6000),
ylim = c(-4000,4000),
zlim = c(-6000,6000)
))
给出:
利用一些矩阵乘法可以节省大量计算时间。
library(dplyr)
library(geometry)
library(rgl)
# define point grid
r <- 50 # resolution
grid <- expand.grid(
x = seq(-6000, 6000, by = r),
y = seq(-4000, 4000, by = r),
z = seq(-6000, 6000, by = r)) # data.table::CJ(x,y,z) if speed is a factor
# get points satisfying every inequality
toPlot <- df %>%
select(x, y, z) %>%
data.matrix %>%
`%*%`(t(grid)) %>%
`<`(df$value) %>%
apply(2, all)
## Alternative way to get points (saves time avoiding apply)
toPlot2 <-
colSums(data.matrix(df[, c('x', 'y', 'z')]) %*% t(grid) < df$value) == nrow(df)
由于不需要内部,将点减少到它们的凸包,然后只绘制表面。
# get convex hull, print volume
gridPoints <- grid[toPlot, ]
hull <- convhulln(gridPoints, "FA")
hull$vol
#> 285767854167
# plot (option 1: colors as in picture)
apply(hull$hull, 1, function(i) gridPoints[i, ]) %>%
lapply(rgl.triangles, alpha = .8, color = gray.colors(5))
## plot (option 2: extract triangles first - much faster avoiding apply)
triangles <- gridPoints[c(t(hull$hull)), ]
rgl.triangles(triangles, alpha=0.8, color=gray.colors(3))
给这个奇怪的融化冰块之类的东西:
我想绘制多个平面,每个平面都是一个不等式。在我绘制完所有平面后,我想将它们组合起来,并为这些线内的区域着色。绘制大量 3d 线并为内部区域着色的图像 - 这就是我想要做的。
我的数据是这样的:
df <- structure(list(z = c(0, 0.06518, 0.08429, -0.01659, 0, 0.06808,
0.12383, -1, -0.01662, 0.28782, 0, -0.09539, 0.04255, 0.09539,
-0.13361, -0.28782, -0.14468, -0.19239, 0.10642), x = c(1, 0.02197,
0.03503, -0.02494, 0, 0.04138, 0.17992, 0, -0.02482, 0.1122,
0, 0.01511, 0.0011, -0.01511, -0.06699, -0.1122, -0.06876, 0.12078,
0.10201), y = c(0, 0.08735, 0.09927, 0.03876, -1, 0.22114, -0.00152,
0, 0.03811, -0.07335, 0, -0.03025, 0.07681, 0.03025, -0.23922,
0.07335, -0.25362, -0.09879, 0.05804), value = c(5801L, 135L,
162L, 109L, 4250L, 655L, 983L, 4500L, 108L, 1594L, 4400L, 540L,
147L, 323L, 899L, 1023L, 938L, 1627L, 327L)), .Names = c("z",
"x", "y", "value"), class = "data.frame", row.names = c(NA, -19L
))
每一行代表一个方程式:z + x + y < value
。 x
是水平值,y
是垂直值,z
是深度。 z 可以求解为:-x - y + value > z。
坐标系的范围是:
x <- z <- seq(-6000, 6000, by = 1)
y <- seq(-4000, 4000, by = 1)
所以,我想从每一行画一个平面。然后我想结合所有这些平面,并填写线条内的值。结果应该看起来像一个多边不等骰子。或者一颗切工丑陋的钻石。
我一直在研究 rgl
和 persp
函数,但我不确定从哪里开始。我愿意接受其他软件推荐。
参考 persp3d
中的示例之一:
x <- seq(-6000, 6000, by = 1)
z <- x
y <- seq(-4000, 4000, by = 1)
f <- function(x, y) <- { r <- -x - y + value > z } # stuck here, can you handle an inequality here?
z <- outer(x, y, f)
open3d()
bg3d("white")
material3d(col = "black")
persp3d(x, y, z, col = "lightblue",
xlab = "X", ylab = "Y", zlab = "z")
我承认这是相当大的限制。如果它有助于减少它们,请随意,或增加 sequence(..., by = )
。
您可以创建一个接受 data.frame 不等式 (df
) 的函数工厂,以及 returns 一个函数:
- 取三个值(x、y、z)
- Returns 如果加载的任何不等式不成立则为 false
工厂:
eval_gen <- function(a,b,c,d){
force(a); force(b); force(c); force(d)
check <- function(x,y,z){
bool <- T
for (i in 1:length(a)){
bool <- bool && (a[i] * x + b[i] * y + c[i] * z < d[i])
}
return(bool)
}
}
然后我们加载不平等数据框,创建函数:
ueq_test <- eval_gen(df$x,df$y,df$z,df$value) #load the inequalities
现在我们需要做的就是创建一个网格,如果所有不等式都成立,就填上颜色:
library(data.table)
library(rgl)
#Note, you can change the resolution by changing the `by` argument here, I've set to 100 to keep computation time and object size manageable
lx <- lz <- seq(-6000, 6000, by = 100)
ly <- seq(-4000, 4000, by = 100)
df_pixels <- data.table(setNames(expand.grid(lx, ly, lz), c("x", "y", "z")))
df_pixels[, Ind := 1:.N]
df_pixels[, Equal := ueq_test(x,y,z), by = Ind]
df_pixels[Equal == T, colour := "red"]
绘图到 rgl:
with(df_pixels[Equal == T, ], plot3d(x=x, y=y, z=z, col= colour, type="p", size=5,
xlim = c(-6000,6000),
ylim = c(-4000,4000),
zlim = c(-6000,6000)
))
给出:
利用一些矩阵乘法可以节省大量计算时间。
library(dplyr)
library(geometry)
library(rgl)
# define point grid
r <- 50 # resolution
grid <- expand.grid(
x = seq(-6000, 6000, by = r),
y = seq(-4000, 4000, by = r),
z = seq(-6000, 6000, by = r)) # data.table::CJ(x,y,z) if speed is a factor
# get points satisfying every inequality
toPlot <- df %>%
select(x, y, z) %>%
data.matrix %>%
`%*%`(t(grid)) %>%
`<`(df$value) %>%
apply(2, all)
## Alternative way to get points (saves time avoiding apply)
toPlot2 <-
colSums(data.matrix(df[, c('x', 'y', 'z')]) %*% t(grid) < df$value) == nrow(df)
由于不需要内部,将点减少到它们的凸包,然后只绘制表面。
# get convex hull, print volume
gridPoints <- grid[toPlot, ]
hull <- convhulln(gridPoints, "FA")
hull$vol
#> 285767854167
# plot (option 1: colors as in picture)
apply(hull$hull, 1, function(i) gridPoints[i, ]) %>%
lapply(rgl.triangles, alpha = .8, color = gray.colors(5))
## plot (option 2: extract triangles first - much faster avoiding apply)
triangles <- gridPoints[c(t(hull$hull)), ]
rgl.triangles(triangles, alpha=0.8, color=gray.colors(3))
给这个奇怪的融化冰块之类的东西: