rgl बहुत अच्छा है, लेकिन धुरी को सही करने के लिए थोड़ा सा प्रयोग लेता है।
यदि आपके पास बहुत सारे अंक हैं, तो उनसे यादृच्छिक नमूना क्यों न लें, और फिर परिणामी सतह को प्लॉट करें। नमूनाकरण की प्रक्रिया आपके डेटा को बहुत प्रभावित कर रही है या नहीं, यह देखने के लिए आप एक ही डेटा से नमूने के आधार पर कई सतहों को जोड़ सकते हैं।
तो, यहां एक बहुत ही भयानक कार्य है, लेकिन ऐसा लगता है कि मुझे लगता है कि आप इसे करना चाहते हैं (लेकिन नमूना के बिना)। एक मैट्रिक्स (एक्स, वाई, जेड) को देखते हुए जहां ज़ेड ऊंचाई है, यह दोनों बिंदुओं और सतह दोनों को भी प्लॉट करेगा। सीमाएं हैं कि प्रत्येक (एक्स, वाई) जोड़ी के लिए केवल एक जेड हो सकता है। तो विमान जो खुद पर लूप वापस समस्याओं का कारण बन जाएगा।
plot_points = T सतह से बने व्यक्तिगत बिंदुओं को प्लॉट करेगा - यह जांचने के लिए उपयोगी है कि सतह और अंक वास्तव में मिलते हैं। plot_contour = T 3 डी विज़ुअलाइजेशन के नीचे 2 डी समोच्च साजिश प्लॉट करेगा। सुंदर रंग देने के लिए 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 पर एक सतह overlays।
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 अंक से उत्पन्न सतहों साजिश) के साथ यह करने की कोशिश की जाएगी। यदि यह काम नहीं करता है, तो इन कार्यों का उपयोग करके कई छोटे नमूने लें और उन्हें एक साथ प्लॉट करें।
जहां plot3d आता है ??? आप किस पैकेज का उपयोग कर रहे हैं? –
आरजीएल, लेकिन मैं – skan