resolucion - inecuaciones lineales

Trazando una serie de desigualdades como aviones

Question

Me gustaría trazar una serie de planos, cada uno es una desigualdad. Después de haber aplicado todos los planos, me gustaría combinarlos y colorear el área dentro de estas líneas. Imagen que dibuja muchas líneas 3d y colorea el área interior; esto es lo que trato de hacer.

Mi información se ve así:

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
))

Cada fila representa una ecuación de la forma: z + x + y < value . x es el valor del ángulo horizontal, y es la vertical z es la profundidad. z se puede resolver como: -x - y + valor> z.

Los límites del sistema de coordenadas son:

x <- z <- seq(-6000, 6000, by = 1)
y <- seq(-4000, 4000, by = 1)

Entonces, de cada fila me gustaría dibujar un avión. Entonces me gustaría combinar todos estos planos y completar los valores dentro de las líneas. El resultado debería parecer un dado desigual de varios lados. O un diamante de corte feo.

He estado jugando con las funciones rgl y persp , pero no estoy seguro de por dónde empezar. Estoy abierto a otras recomendaciones de software.

Apoyándose en uno de los ejemplos de 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")

Reconozco que son límites bastante grandes. Si ayuda a reducirlos, siéntete libre o para aumentar la sequence(..., by = ) .

Answer 1

Puede ahorrar mucho en tiempo de cálculo aprovechando la multiplicación de matrices.

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)

Como no necesita el interior, reduzca los puntos a su casco convexo y trace la superficie.

# 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))

Dando este tipo extraño de cubo de hielo derretido:

Answer 2

Puede crear una fábrica de funciones que tome un data.frame of inequalities ( df ) y devuelva una función que:

1. Toma tres valores (x, y, z)
2. Devuelve falso si alguna de las desigualdades cargadas no retiene

Fábrica:

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)
}
}

Luego cargamos en el marco de datos de desigualdad, creando la función:

ueq_test <- eval_gen(df$x,df$y,df$z,df$value) #load the inequalities

Ahora todo lo que tenemos que hacer es crear una grilla y colorear si todas las desigualdades se mantienen:

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"]

Parcela a 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)
))

Lo que da: