--- title: "Kaluza-Klein Theory" subtitle: "[Back To TCIU Contents](https://tciu.predictive.space/)" author: "SOCR Team " date: "`r format(Sys.time(),'%m/%d/%Y')`" output: html_document: theme: spacelab highlight: tango includes: before_body: TCIU_header.html toc: true number_sections: true toc_depth: 2 toc_float: collapsed: false smooth_scroll: true code_folding: hide --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, warings = FALSE) ``` # Figure 3.5 ```{r message=F, warning=F} 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 ```