---
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

```



<!--html_preserve-->
<div>
    	<footer><center>
			<a href="https://www.socr.umich.edu/">SOCR Resource</a>
				Visitor number <img class="statcounter" src="https://c.statcounter.com/5714596/0/038e9ac4/0/" alt="Web Analytics" align="middle" border="0">
				<script type="text/javascript">
					var d = new Date();
					document.write(" | " + d.getFullYear() + " | ");
				</script> 
				<a href="https://socr.umich.edu/img/SOCR_Email.png"><img alt="SOCR Email"
	 			title="SOCR Email" src="https://socr.umich.edu/img/SOCR_Email.png"
	 			style="border: 0px solid ;"></a>
	 		 </center>
	 	</footer>

	<!-- Start of StatCounter Code -->
		<script type="text/javascript">
			var sc_project=5714596; 
			var sc_invisible=1; 
			var sc_partition=71; 
			var sc_click_stat=1; 
			var sc_security="038e9ac4"; 
		</script>
		
		<script type="text/javascript" src="https://www.statcounter.com/counter/counter.js"></script>
	<!-- End of StatCounter Code -->
	
	<!-- GoogleAnalytics -->
		<script src="https://www.google-analytics.com/urchin.js" type="text/javascript"> </script>
		<script type="text/javascript"> _uacct = "UA-676559-1"; urchinTracker(); </script>
	<!-- End of GoogleAnalytics Code -->
</div>
<!--/html_preserve-->