2015-12-14 10 views
10

मैं कई विमानों को साजिश करना चाहता हूं, प्रत्येक एक असमानता है। मेरे पास सभी विमानों को प्लॉट करने के बाद, मैं उन्हें जोड़ना चाहता हूं, और इन पंक्तियों के अंदर क्षेत्र को रंगना चाहता हूं। छवि 3 डी लाइनों को खींचती है और अंदर के क्षेत्र को रंग देती है - यही वह है जो मैं करने की कोशिश कर रहा हूं।विमानों के रूप में कई असमानताओं को प्लॉट करना

मेरे डेटा इस तरह दिखता है:

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 < valuex क्षैतिज मूल्य है, y लंबवत है और 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 =) को बढ़ाने में मदद करता है।

+1

"लाइनों" के लिए, आप "विमानों" मतलब है, सही है? – eh9

+0

बेहतर होगा यदि आप यह दिखाने के लिए पेंट के साथ एक मसौदा तैयार कर सकते हैं कि ग्राफ कैसा दिखता है। – Patric

+0

हाँ, मेरा मतलब विमान है। एक बदसूरत कट हीरा की कल्पना करो। यही वही दिखना चाहिए। – NoThanks

उत्तर

4

आप कुछ मैट्रिक्स गुणा का लाभ उठाकर गणना समय पर एक बहुत कुछ बचा सकते हैं।

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

बात के इस अजीब पिघल आइस क्यूब तरह देते:

Weird melty ice cube thing

+0

@slickrickulicious: जोड़ा गया। धन्यवाद! – user2802241

+0

बिल्कुल सही! पूर्ण रूप से! – NoThanks

2

आप एक समारोह कारखाने कि असमानताओं (df) के एक data.frame में ले जाता है बना सकते हैं, और एक समारोह है कि रिटर्न:

  1. तीन मूल्यों (एक्स, वाई, जेड)
  2. रिटर्न झूठी ले जाता है असमानताओं लोड के किसी भी पकड़ नहीं है

फैक्टरी:

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

हम तो असमानता dataframe में लोड, समारोह बनाने:

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

देता है कौन सा:

enter image description here

संबंधित मुद्दे