How to plot an informative stratified surface graph?

1
votes

I want to plot 3D data d1 that is stratified by n. Thanks to this answer I achieved following solution with rgl so far, which already looks nice though I couldn't find a way to rotate the plot to the best perspective there. More straightforward in this regard seems to be plotly, where one can rotate the graph with the mouse. The latter also already has the color shade I need with corresponding legend. Though in both ways I don't understand how to save the graph resp. how to knit it into rmarkdown what I'm intending to do. I'm not depending on a particular package, just want the following:

  • strata
  • color/texture shade w/ legend
  • savable, knitable

Here my attempt, data below.

car::some(d1, 5)
#        n   x   y        value
# 37  1000 0.0 0.0 0.000000e+00
# 93  2000 0.3 0.2 2.500834e-04
# 101 2000 0.4 0.4 3.201067e-04
# 111 4000 0.0 0.2 2.400160e-05
# 142 4000 0.5 0.3 6.400427e-05

# change levels
levels <- levels(d1$n)  # preserve for later
d1$n <- as.factor(as.numeric(d1$n))

# arrayer
arrayIt <- function(x){
  # makes array of d1 by x, y, z
  d <- sqrt(nrow(x)/length(unique(x[, 1])))  # dim. of matrices
  ar <- array(NA, c(d, d, 3))  # init. array
  ar[, , 1] <- matrix(x[, 2], d, d)  # x
  ar[, , 2] <- matrix(x[, 3], d, d)  # y
  ar[, , 3] <- matrix(x[, 4], d, d)  # z
  return(ar)
}

# list of 4 arrays for each  n
ls1 <- lapply(seq_along(unique(d1[, 1])), function(n) arrayIt(d1[d1[, 1] == n, ]))

# plot
library(rgl)
lapply(seq_along(unique(d1$n)), function(i){
  x <- ls1[[i]][,,1]
  y <- ls1[[i]][,,2]
  z <- ls1[[i]][,,3]
  persp3d(x, y, z, col = i, alpha = .5, add = i > 1)  # MARK
})

enter image description here

E.g. plotly already provides color shade and legend, which is very informative but plot_ly won't work in the lapply above, I also didn't find an option how to add a stratum.

library(plotly)
plot_ly(x=x, y=y, z=z, type = "surface")  # inserted at MARK didn't work

enter image description here

In sum, the desired result would be something like the intersection of both graphs.

Data:

data <- structure(list(n = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
                                   1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
                                   1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
                                   2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
                                   2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
                                   3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
                                   3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
                                   3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 
                                   4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 
                                   4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("500", "1000", "2000", 
                                                                               "4000"), class = "factor"), x = c(0, 0, 0, 0, 0, 0, 0.1, 0.1, 
                                                                                                                 0.1, 0.1, 0.1, 0.1, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.3, 0.3, 0.3, 
                                                                                                                 0.3, 0.3, 0.3, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.5, 0.5, 0.5, 0.5, 
                                                                                                                 0.5, 0.5, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.2, 
                                                                                                                 0.2, 0.2, 0.2, 0.2, 0.2, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.4, 0.4, 
                                                                                                                 0.4, 0.4, 0.4, 0.4, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0, 0, 0, 0, 
                                                                                                                 0, 0, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.2, 0.2, 0.2, 0.2, 0.2, 
                                                                                                                 0.2, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 
                                                                                                                 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 
                                                                                                                 0.1, 0.1, 0.1, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.3, 0.3, 0.3, 0.3, 
                                                                                                                 0.3, 0.3, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.5, 0.5, 0.5, 0.5, 0.5, 
                                                                                                                 0.5), y = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 
                                                                                                                             0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 
                                                                                                                             0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 
                                                                                                                             0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 
                                                                                                                             0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 
                                                                                                                             0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 
                                                                                                                             0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 
                                                                                                                             0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 
                                                                                                                             0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 
                                                                                                                             0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 
                                                                                                                             0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 
                                                                                                                             0.5), value = c(0, 0.000253671562082777, 0.00048064085447263, 
                                                                                                                                             0.000680907877169559, 0.000854472630173565, 0.00100133511348465, 
                                                                                                                                             0.000253671562082777, 0.00048064085447263, 0.000680907877169559, 
                                                                                                                                             0.000854472630173565, 0.00100133511348465, 0.0011214953271028, 
                                                                                                                                             0.00048064085447263, 0.000680907877169559, 0.000854472630173565, 
                                                                                                                                             0.00100133511348465, 0.0011214953271028, 0.00121495327102804, 
                                                                                                                                             0.000680907877169559, 0.000854472630173565, 0.00100133511348465, 
                                                                                                                                             0.0011214953271028, 0.00121495327102804, 0.00128170894526035, 
                                                                                                                                             0.000854472630173565, 0.00100133511348465, 0.0011214953271028, 
                                                                                                                                             0.00121495327102804, 0.00128170894526035, 0.00132176234979973, 
                                                                                                                                             0.00100133511348465, 0.0011214953271028, 0.00121495327102804, 
                                                                                                                                             0.00128170894526035, 0.00132176234979973, 0.00133511348464619, 
                                                                                                                                             0, 0.000126751167444963, 0.000240160106737825, 0.000340226817878586, 
                                                                                                                                             0.000426951300867245, 0.000500333555703803, 0.000126751167444963, 
                                                                                                                                             0.000240160106737825, 0.000340226817878586, 0.000426951300867245, 
                                                                                                                                             0.000500333555703803, 0.000560373582388259, 0.000240160106737825, 
                                                                                                                                             0.000340226817878586, 0.000426951300867245, 0.000500333555703803, 
                                                                                                                                             0.000560373582388259, 0.000607071380920614, 0.000340226817878586, 
                                                                                                                                             0.000426951300867245, 0.000500333555703803, 0.000560373582388259, 
                                                                                                                                             0.000607071380920614, 0.000640426951300867, 0.000426951300867245, 
                                                                                                                                             0.000500333555703803, 0.000560373582388259, 0.000607071380920614, 
                                                                                                                                             0.000640426951300867, 0.000660440293529019, 0.000500333555703803, 
                                                                                                                                             0.000560373582388259, 0.000607071380920614, 0.000640426951300867, 
                                                                                                                                             0.000660440293529019, 0.00066711140760507, 0, 6.33544514838279e-05, 
                                                                                                                                             0.000120040013337779, 0.000170056685561854, 0.000213404468156052, 
                                                                                                                                             0.000250083361120373, 6.33544514838279e-05, 0.000120040013337779, 
                                                                                                                                             0.000170056685561854, 0.000213404468156052, 0.000250083361120373, 
                                                                                                                                             0.000280093364454818, 0.000120040013337779, 0.000170056685561854, 
                                                                                                                                             0.000213404468156052, 0.000250083361120373, 0.000280093364454818, 
                                                                                                                                             0.000303434478159386, 0.000170056685561854, 0.000213404468156052, 
                                                                                                                                             0.000250083361120373, 0.000280093364454818, 0.000303434478159386, 
                                                                                                                                             0.000320106702234078, 0.000213404468156052, 0.000250083361120373, 
                                                                                                                                             0.000280093364454818, 0.000303434478159386, 0.000320106702234078, 
                                                                                                                                             0.000330110036678893, 0.000250083361120373, 0.000280093364454818, 
                                                                                                                                             0.000303434478159386, 0.000320106702234078, 0.000330110036678893, 
                                                                                                                                             0.000333444481493831, 0, 1.26675111674112e-05, 2.40016001066738e-05, 
                                                                                                                                             3.40022668177879e-05, 4.26695113007534e-05, 5.00033335555704e-05, 
                                                                                                                                             1.26675111674112e-05, 2.40016001066738e-05, 3.40022668177879e-05, 
                                                                                                                                             4.26695113007534e-05, 5.00033335555704e-05, 5.60037335822388e-05, 
                                                                                                                                             2.40016001066738e-05, 3.40022668177879e-05, 4.26695113007534e-05, 
                                                                                                                                             5.00033335555704e-05, 5.60037335822388e-05, 6.06707113807587e-05, 
                                                                                                                                             3.40022668177879e-05, 4.26695113007534e-05, 5.00033335555704e-05, 
                                                                                                                                             5.60037335822388e-05, 6.06707113807587e-05, 6.40042669511301e-05, 
                                                                                                                                             4.26695113007534e-05, 5.00033335555704e-05, 5.60037335822388e-05, 
                                                                                                                                             6.06707113807587e-05, 6.40042669511301e-05, 6.60044002933529e-05, 
                                                                                                                                             5.00033335555704e-05, 5.60037335822388e-05, 6.06707113807587e-05, 
                                                                                                                                             6.40042669511301e-05, 6.60044002933529e-05, 6.66711114074272e-05
                                                                                                                             )), .Names = c("n", "x", "y", "value"), row.names = c(NA, -144L
                                                                                                                             ), class = "data.frame")
2
rplot3dplotlyrgl
Not sure why rotation isn't working for you. What output format do you need? - user2554330
@user2554330 see my comment to your answer - jay.sf
I don't have an answer to this one... But if you want PDF output, it's hard. Interactive graphics in PDF are not well supported by viewers. You could try rgl::writeASY, but it's likely to be disappointing. - user2554330

2 Answers

2
votes

You need to make use of add_surface() in plotly... And your data needs to be in matrix form for the surface plot. The plotly website has decent documentation for all sorts of plots. https://plot.ly/r/3d-surface-plots/. To get only one color scale set showscale==FALSE in the plotly command and then turn it back on for one of the plots.

z <- lapply(unique(data$n), 
            function(x) as.matrix(reshape(data[data$n==x,-1], 
                                          idvar = "x", timevar = "y", direction = "wide") ))

plot_ly(showscale=FALSE) %>% add_surface(z=~z[[1]][, -1], cmin=min(data$value), cmax=max(data$value), showscale=TRUE) %>%
  add_surface(z = ~z[[2]][, -1], cmin=min(data$value), cmax=max(data$value)) %>%
  add_surface(z=~z[[3]][,-1], cmin=min(data$value), cmax=max(data$value)) %>%
  add_surface(z~z[[4]][,-1], cmin=min(data$value), cmax=max(data$value))

Old plot with cmin cmax unset

enter image description here

New plot with cmin and cmax set so that z value is colored consistently across all strata

enter image description here

2
votes

Just as a different view on your data - because the four surfaces in single 3D plot are looking a little too busy - you can try to use contour lines and coloring on the value. (I'm not sure what particular aspect of the data set you need to stress/analyze.)

contour lines

library(tidyverse)
library(viridis)

data %>%
  ggplot(aes(x, y)) +
  geom_raster(aes(fill = value), interpolate = T) +
  geom_contour(aes(z = value), bins = 15) +
  facet_wrap(~ n, nrow = 1) +
  scale_fill_viridis()