如何在3D环境中选择多个凸包的颜色并在图例中显示它们？

Question

我在 R 上的 plot_ly 中为不同组的不同个体构建了一个 3D 环境，其中包含多个点。我能够为每个组获得凸包，但我无法为这些组获得相同的颜色凸包作为用于点的凸包，也不在图例中显示它们。

这是我的数据的子集（15 行）：

structure(list(Dim.1 = c(-1.66218218068351, -1.54089611716482, 
-1.69396481956502, -2.17390793775836, -1.89654148822055, 0.133830523545437, 
0.259380958887321, 2.33273285516635, 0.614041383064022, -0.810456498949672, 
2.39414605406972, -0.270490723379913, 0.040624581491233, -0.860085321535654, 
-0.413284603509167, -1.19945764685421, -1.26198490666151, -1.64169470146003, 
-1.41841286755302, 0.116487687654103), Dim.2 = c(1.49013624024412, 
1.10841192775609, 1.36146620587346, 1.47562095807774, 1.40859174651776, 
1.85902171972337, 0.95918804016952, 1.44285670285851, 1.4351058325854, 
1.43065490325377, 1.00461883606259, 0.968929418999014, 0.732442016325051, 
1.80653021141781, 1.31788279983938, 1.27857296355683, 1.16339072990495, 
0.907778819038107, 1.1817781892271, 1.31747874027895), Dim.3 = c(0.448901070403223, 
0.71293085815581, 0.352289255436, 0.104996470361541, -0.00283165166254734, 
2.06082198348797, 2.52481753102989, -1.82823279868644, -0.590469705411186, 
0.101347585955537, -1.82539174036341, 0.521849361206393, 0.968259325821575, 
0.461483660862223, 0.822832783406133, -0.118440056106547, -0.465652890222368, 
-0.00627950759397972, -0.0843161614907643, -0.59313525893342), 
    Dim.4 = c(0.102369924556286, -0.0494120833525201, 0.834691238274808, 
    1.02831262202516, 0.826646086870935, -0.194159779209062, 
    0.704421397982499, 0.631555743217968, -0.713739725809427, 
    -0.131700651175048, 0.504854959572457, -0.570815838805, -1.08543238856329, 
    -0.49193828964481, -0.646650107593492, -0.107973575557607, 
    0.499541481565648, 0.0754431235885086, 0.389310696606881, 
    -0.141921543536795), Dim.5 = c(0.330069037381444, 0.760600822514828, 
    -0.155589492459669, -0.0135600742996482, -0.490304544490695, 
    0.735768333842011, 1.15227810337527, 0.199683055278656, 0.0795865046516087, 
    -0.603990571540292, -0.0419153340483225, -0.761770057884459, 
    -0.317137855265087, -0.325142467426912, -0.359402866621409, 
    -0.104936413340002, -0.100995473052205, -0.361928650451333, 
    -0.180283743190224, 0.163354435137426), Dim.6 = c(0.002982792864095, 
    0.231149659780945, 0.246398896715352, 0.319166032495582, 
    0.168209515277733, -0.630241510076728, -0.0913262723424757, 
    0.204626646512167, -0.106585804403048, 0.160084061288814, 
    0.336839824688217, -0.329428140898598, -0.604000676394403, 
    -0.246446571559567, -0.341960218562125, 0.239923595501739, 
    0.789228711878082, 0.195214145049783, 0.259585914185282, 
    0.324052751084852), Dim.7 = c(0.128134395954979, 0.0940080998379301, 
    0.0532691636740985, 0.0910309933055206, 0.0268173111574301, 
    0.301612442049654, 0.216730382065579, 0.00641657095998016, 
    -0.0784922450876965, -0.0758809037776677, -0.0457154790569843, 
    -0.0157086271797873, 0.13228966072771, 0.0866623211603163, 
    0.181421902637019, -0.177911254203293, -0.313422817560999, 
    0.0244700898604691, -0.0460004297419735, -0.112989594607267
    ), Dim.8 = c(0.0589080578109871, 0.103479814889764, 0.0972768921679227, 
    0.020839419598068, 0.137957898212134, -0.115299052903416, 
    -0.102409767146569, 0.0458647224401064, -0.0253650327056998, 
    0.172102502489923, 0.331980164969441, 0.0457063711034664, 
    0.0705283789649083, -0.0676008615860532, -0.0344453848031957, 
    0.138255360922819, 0.0871484452301794, 0.134727513167339, 
    0.081843338313648, 0.208095205376299), gen = c("<i> Flammeo </i>", 
    "<i> Flammeo </i>", "<i> Holocentrus </i>", "<i> Holocentrus </i>", 
    "<i> Holocentrus </i>", "<i> Holocentrus </i>", "<i> Holocentrus </i>", 
    "<i> Myripristis </i>", "<i> Myripristis </i>", "<i> Myripristis </i>", 
    "<i> Myripristis </i>", "<i> Neoniphon </i>", "<i> Neoniphon </i>", 
    "<i> Neoniphon </i>", "<i> Neoniphon </i>", "<i> Sargocentron </i>", 
    "<i> Sargocentron </i>", "<i> Sargocentron </i>", "<i> Sargocentron </i>", 
    "<i> Sargocentron </i>"), spe_id_ori = c("fla_mar_2_guad", 
    "fla_mar_4_guad", "holo_ads_3_guad", "holo_ads_4_guad", "holo_ads_5_guad", 
    "holo_ruf_1_guad", "holo_ruf_2_guad", "myr_adu_3_pf", "myr_adu_3_sey", 
    "myr_adu_4_gu", "myr_adu_4_pf", "neo_sam_4_pf", "neo_sam_4_ph", 
    "neo_sam_4_sey", "neo_sam_5_pf", "sar_pra_1_sey", "sar_pra_2_sey", 
    "sar_pra_3_sey", "sar_pra_6_sey", "sar_pra_7_ph"), subfamily = c("Holocentrinae", 
    "Holocentrinae", "Holocentrinae", "Holocentrinae", "Holocentrinae", 
    "Holocentrinae", "Holocentrinae", "Myripristinae", "Myripristinae", 
    "Myripristinae", "Myripristinae", "Holocentrinae", "Holocentrinae", 
    "Holocentrinae", "Holocentrinae", "Holocentrinae", "Holocentrinae", 
    "Holocentrinae", "Holocentrinae", "Holocentrinae")), row.names = c(NA, 
-20L), class = c("tbl_df", "tbl", "data.frame"))

我的 3D 环境：

plot3D_genres <- plot_ly(data = test, x = ~Dim.1, y = ~Dim.2, z = ~Dim.3, type = "scatter3d", mode = "markers",
                         color = ~gen, colors = c("#00BC00", "#8B2DB2", "#FC4E07", "#E7B800", "#00AFBB"), 
                         symbol = ~subfamily, symbols = c('square', 'circle'), # circle, cross, square, 'diamond', 'x'
                         legendgroup = ~gen) %>%
  add_markers(showlegend = FALSE, name = ~spe_id_ori) %>% # name = ~spe ou ~tribe (les infos données sur les points)
  layout(scene = list(
    xaxis = list(title = 'PC1 (47%)'),
    yaxis = list(title = 'PC2 (19%)'),
    zaxis = list(title = 'PC3 (16%)')),
    legend = list(title=list(text='<b> Genus </b>'), font = list(size = 18), x = 0.85, y = 0.5)
  ) 
plot3D_genres

这就是我构建凸包的方法：

test$gen <- ifelse(test$gen == "<i> Sargocentron </i>", "Sargocentron", 
                               ifelse(test$gen == "<i> Neoniphon </i>", "Neoniphon",
                                      ifelse(test$gen == "<i> Holocentrus </i>", "Holocentrus",
                                             ifelse(test$gen == "<i> Flammeo </i>", "Flammeo",
                                                    ifelse(test$gen == "<i> Myripristis </i>", "Myripristis",  test$gen)))))

# Get unique 'gen' values
unique_gen_values <- c("Holocentrus", "Myripristis", "Neoniphon", "Sargocentron")
# Create a color mapping based on the 'gen' values in plot3D_genres
color_mapping <- c("#8B2DB2", "#FC4E07", "#E7B800", "#00AFBB")
# Create an empty list to store the hull plots
hull_plots <- list()
# Iterate through each 'gen' value
for (g in unique_gen_values) {
  # Subset data for the current 'gen'
  gen_data <- test[test$gen == g, 1:9]
  # Compute the convex hull
  hull <- cxhull(as.matrix(gen_data[, c("Dim.1", "Dim.2", "Dim.3")]), triangulate = TRUE)
  # Extract the vertices and faces from the convex hull
  mesh <- hullMesh(hull, simplify = TRUE, rgl = FALSE)
  vertices <- mesh$vertices
  faces <- mesh$faces
  # Color
  current_color <- color_mapping[i]
  # Create 3D mesh plot for the convex hull with the same color as in the scatter plot
  hull_plot <- plot_ly(x = vertices[, 1], y = vertices[, 2], z = vertices[, 3],
                       i = faces[, 1] - 1, j = faces[, 2] - 1, k = faces[, 3] - 1,
                       type = "mesh3d",
                       opacity = 0.5, name = paste("<i>", g, "</i>"), color = I(current_color)) # paste("Convex Hull ", g)
  
  # Add the hull plot to the list
  hull_plots[[g]] <- hull_plot
}
# Combine hull plots using subplot
combined_hull_plots <- subplot(plot3D_genres,
  hull_plots[[unique_gen_values[1]]],
  hull_plots[[unique_gen_values[2]]],
  hull_plots[[unique_gen_values[3]]],
  hull_plots[[unique_gen_values[4]]]
)

1- 尽管存在颜色争论，但凸包的颜色似乎是由 R 任意选择的。 2-我无法选择是否显示凸包，因为它们不显示在图例中；这是我希望能够做的事情，因为可以通过单击图例中的元素来对plot_ly中的点执行此操作。

非常感谢您的帮助，

海洋。

Answer 1

我没看到

i

中的

color_mapping[i]

是什么。我认为你需要做：

for(i in 1:4) {
  # Subset data for the current 'gen'
  g <- unique_gen_values[i]
  gen_data <- test[test$gen == g, 1:9]
  # Compute the convex hull
  hull <- cxhull(as.matrix(gen_data[, c("Dim.1", "Dim.2", "Dim.3")]), triangulate = TRUE)
  # Extract the vertices and faces from the convex hull
  mesh <- hullMesh(hull, simplify = TRUE, rgl = FALSE)
  vertices <- mesh$vertices
  faces <- mesh$faces
  # Color
  current_color <- color_mapping[i]
  ......