library(plotly)
# parameter space sweep for the spherical coordinates
phi <- seq(from = 0, to = 2*pi, by = ((2*pi - 0)/(200 - 1)))
psi <- seq(from = 0, to = pi, by = ((pi - 0)/(200 - 1)))
# shape=="cone1")
# rendering (u,v) parametric surfaces requires x,y,z arguments to be 2D arrays
# In out case, the three coordinates have to be 200*200 parameterized tensors/arrays
h1= 10 # cone height
r1 = seq(from = 0, to = h1, by = ((h1 - 0)/(200 - 1))) # r = radius
x1 = 20* ((h1 - r1)/h1 ) %o% rep(1, 200) # x = 3*r
y1 = 3* ((h1 - r1)/h1 ) %o% sin(phi) # y = r*sin(phi)
z1 = 3* ((h1 - r1)/h1 ) %o% cos(phi) # z = r*cos(phi)
# circle1 boundary
x11 = rep(20, 200) %o% rep(1, 200) # x = 20
y11 = 3* ((h1 - r1)/h1 ) %o% sin(phi) # y = r*sin(phi)
z11 = 3* ((h1 - r1)/h1 ) %o% cos(phi) # z = r*cos(phi)
# shape=="cone2")
h2= 10 # cone height
r2 = seq(from = 0, to = h2, by = ((h2 - 0)/(200 - 1))) # r = radius
x2 = 20* ((h2 - r2)/h2 ) %o% rep(1, 200) # x = 3*r
y2 = 2* ((h2 - r2)/h2 ) %o% sin(phi) # y = r*sin(phi)
z2 = 2* ((h2 - r2)/h2 ) %o% cos(phi) # z = r*cos(phi)
# circle2 boundary
x21 = rep(20, 200) %o% rep(1, 200) # x = 20
y21 = 2* ((h2 - r2)/h2 ) %o% sin(phi) # y = r*sin(phi)
z21 = 2* ((h2 - r2)/h2 ) %o% cos(phi) # z = r*cos(phi)
# shape=="cone3")
h3= 10 # cone height
r3 = seq(from = 0, to = h3, by = ((h3 - 0)/(200 - 1))) # r = radius
x3 = 15* ((h3 - r3)/h3 ) %o% rep(1, 200) # x = 3*r
y3 = 3* ((h3 - r3)/h3 ) %o% sin(phi) # y = r*sin(phi)
z3 = 3* ((h3 - r3)/h3 ) %o% cos(phi) # z = r*cos(phi)
# circle2 boundary
x31 = rep(15, 200) %o% rep(1, 200) # x = 15
y31 = 3* ((h3 - r3)/h3) %o% sin(phi) # y = r*sin(phi)
z31 = 3* ((h3 - r3)/h3) %o% cos(phi) # z = r*cos(phi)
shape_names <- c("cone1", "cone2", "cone3")
# https://plot.ly/r/custom-buttons/
# updatemenus component
updatemenus <- list(
list(
active = -1,
type = 'buttons',
buttons = list(
list(
label = shape_names[1],
method = "update",
args = list(list(visible = c(TRUE, FALSE, FALSE)),
list(title = shape_names[1]))),
list(
label = shape_names[2],
method = "update",
args = list(list(visible = c(FALSE, TRUE, FALSE)),
list(title = shape_names[2]))),
list(
label = shape_names[3],
method = "update",
args = list(list(visible = c(FALSE, FALSE, TRUE)),
list(title = shape_names[3])))
)
)
)
p <- plot_ly(hoverinfo="none", legendshow=FALSE, showscale = FALSE) %>%
# AXES
# Add a Z-direction scaling point
add_trace(x=~x1[1,1], y= ~0, z= 5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the x-axis1
add_trace(x=~1.1*x1[,1], y= ~0, z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the x-axis2
add_trace(x=~1.1*x1[,1], y= ~1*10, z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the x-axis3
add_trace(x=~1.1*x1[,1], y= ~2*10, z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the x-axis4
add_trace(x=~1.1*x1[,1], y= ~3*10, z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the y-axis1
add_trace(x=5, y=y1[,1], z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the y-axis2
add_trace(x=10, y=y1[,1], z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the y-axis3
add_trace(x=15, y=y1[,1], z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the y-axis4
add_trace(x=20, y=y1[,1], z= ~-3/5, type="scatter3d", mode="lines",
line = list(width = 10, color="gray"), name="Z",
hoverinfo="none", legendshow=F) %>%
# ROW 1
# trace the boundary of circle1 surface
add_trace(x=~x1[1,], y=~y11[1,], z=~z11[1,]/5, type="scatter3d", mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle2 surface
add_trace(x=~x1[1,],y=~y11[1,]+1*10,z=~z11[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle3 surface
add_trace(x=~x1[1,],y=~y11[1,]+2*10,z=~z11[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle4 surface
add_trace(x=~x1[1,],y=~y11[1,]+3*10,z=~z11[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# add centers for kime circle 1...4 at location x1
add_trace(x=~x1[1,1], y= ~0, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~x1[1,1], y= +1*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~x1[1,1], y= +2*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~x1[1,1], y= +3*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
# ROW 2
# trace the boundary of circle1 surface
add_trace(x=~x3[1,], y=~y31[1,], z=~z31[1,]/5, type="scatter3d", mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle2 surface
add_trace(x=~x3[1,],y=~y31[1,]+1*10,z=~z31[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle3 surface
add_trace(x=~x3[1,],y=~y31[1,]+2*10,z=~z31[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle4 surface
add_trace(x=~x3[1,],y=~y31[1,]+3*10,z=~z31[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# add centers for kime circle 1...4 at location x1
add_trace(x=~x3[1,1], y= ~0, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~x3[1,1], y= +1*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~x3[1,1], y= +2*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~x3[1,1], y= +3*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
# ROW 3
# trace the boundary of circle1 surface
add_trace(x=~2*x3[1,]-x1[1,], y=y31[1,], z=~z31[1,]/5, type="scatter3d", mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle2 surface
add_trace(x=~2*x3[1,]-x1[1,],y=~y31[1,]+1*10,z=~z31[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle3 surface
add_trace(x=~2*x3[1,]-x1[1,],y=~y31[1,]+2*10,z=~z31[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of circle4 surface
add_trace(x=~2*x3[1,]-x1[1,],y=~y31[1,]+3*10,z=~z31[1,]/5,type="scatter3d",mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# add centers for kime circle 1...4 at location x1
add_trace(x=~2*x3[1,1]-x1[1,1], y= ~0, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~2*x3[1,1]-x1[1,1], y= +1*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~2*x3[1,1]-x1[1,1], y= +2*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
add_trace(x=~2*x3[1,1]-x1[1,1], y= +3*10, z= -3/5, type="scatter3d", mode="markers",
line = list(width = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
# LAYOUT
layout(title = "Choose a kime Cone", showlegend = FALSE, updatemenus = updatemenus,
scene = list(xaxis=list(title="X"),yaxis=list(title="Y"),zaxis=list(title="Z")))
p