{
 "cells": [
  {
   "cell_type": "markdown",
   "id": "bf752426",
   "metadata": {},
   "source": [
    "# Riemann Curvature Tensor of $S^7$\n",
    "\n",
    "A round 7-sphere of radius $r$ has constant sectional curvature\n",
    "$1/r^2$.  This notebook builds its metric, Levi-Civita connection, Riemann\n",
    "tensor, Ricci tensor, and scalar curvature in indexed Egison notation.\n",
    "\n",
    "We use the convention\n",
    "\n",
    "$$\n",
    "R^i{}_{jkl}\n",
    "  = \\partial_k\\Gamma^i{}_{jl}\n",
    "  - \\partial_l\\Gamma^i{}_{jk}\n",
    "  + \\Gamma^m{}_{jl}\\Gamma^i{}_{mk}\n",
    "  - \\Gamma^m{}_{jk}\\Gamma^i{}_{ml}.\n",
    "$$\n"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "e69d2760",
   "metadata": {},
   "source": [
    "## Hyperspherical chart\n",
    "\n",
    "The coordinates are $x=(\\alpha, \\beta, \\gamma, \\delta, \\xi, \\zeta, \\eta)$.  The standard embedding\n",
    "$X:S^7\\hookrightarrow\\mathbb{R}^8$ is built by\n",
    "successively multiplying by sines: $X_1=r\\cos \\alpha$,\n",
    "$X_2=r\\sin \\alpha\\cos \\beta$, and so on.  It makes\n",
    "$X\\mathbin{\\cdot}X=r^2$ manifest.\n",
    "\n",
    "The chart excludes the usual coordinate poles; those singularities are\n",
    "features of hyperspherical coordinates, not of the round geometry.\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 1,
   "id": "671fc0e8",
   "metadata": {},
   "outputs": [],
   "source": [
    "declare symbol r, α, β, γ, δ, ξ, ζ, η: MathValue\n",
    "\n",
    "def x : Vector MathValue := [| α, β, γ, δ, ξ, ζ, η |]\n",
    "\n",
    "def X : Vector MathValue := [| r * cos α, r * sin α * cos β, r * sin α * sin β * cos γ, r * sin α * sin β * sin γ * cos δ, r * sin α * sin β * sin γ * sin δ * cos ξ, r * sin α * sin β * sin γ * sin δ * sin ξ * cos ζ, r * sin α * sin β * sin γ * sin δ * sin ξ * sin ζ * cos η, r * sin α * sin β * sin γ * sin δ * sin ξ * sin ζ * sin η |]\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 2,
   "id": "d4a87097",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$\\begin{pmatrix} \\cos(α) r \\\\ \\cos(β) \\sin(α) r \\\\ \\cos(γ) \\sin(α) \\sin(β) r \\\\ \\cos(δ) \\sin(α) \\sin(β) \\sin(γ) r \\\\ \\cos(ξ) \\sin(α) \\sin(β) \\sin(γ) \\sin(δ) r \\\\ \\cos(ζ) \\sin(α) \\sin(β) \\sin(γ) \\sin(δ) \\sin(ξ) r \\\\ \\cos(η) \\sin(α) \\sin(β) \\sin(γ) \\sin(δ) \\sin(ζ) \\sin(ξ) r \\\\ \\sin(α) \\sin(β) \\sin(γ) \\sin(δ) \\sin(ζ) \\sin(η) \\sin(ξ) r\\\\ \\end{pmatrix}$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "X\n"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "2d70bfb3",
   "metadata": {},
   "source": [
    "## Metric and inverse metric\n",
    "\n",
    "Differentiating the embedding gives an orthogonal coordinate basis.  Its\n",
    "line element is\n",
    "\n",
    "$$\n",
    "ds^2=r^2\\left(d\\alpha^2 + \\sin^2 \\alpha d\\beta^2 + \\sin^2 \\alpha \\sin^2 \\beta d\\gamma^2 + \\sin^2 \\alpha \\sin^2 \\beta \\sin^2 \\gamma d\\delta^2 + \\sin^2 \\alpha \\sin^2 \\beta \\sin^2 \\gamma \\sin^2 \\delta d\\xi^2 + \\sin^2 \\alpha \\sin^2 \\beta \\sin^2 \\gamma \\sin^2 \\delta \\sin^2 \\xi d\\zeta^2 + \\sin^2 \\alpha \\sin^2 \\beta \\sin^2 \\gamma \\sin^2 \\delta \\sin^2 \\xi \\sin^2 \\zeta d\\eta^2\\right).\n",
    "$$\n",
    "\n",
    "Egison differentiates the embedding to obtain the coordinate tangent\n",
    "vectors and constructs every component as their dot product,\n",
    "$g_{ij}=\\partial_iX\\mathbin{\\cdot}\\partial_jX$.  The inverse metric is\n",
    "then computed from that induced metric.\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 3,
   "id": "f8225816",
   "metadata": {},
   "outputs": [],
   "source": [
    "def e_i_j : Matrix MathValue := ∂/∂ X_j x~i\n",
    "\n",
    "def g_i_j : Matrix MathValue :=\n",
    "  generateTensor (\\[a, b] -> V.* e_a_# e_b_#) [7, 7]\n",
    "\n",
    "def g~i~j : Matrix MathValue := M.inverse g_#_#\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 4,
   "id": "12a3ad6f",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$\\begin{pmatrix} r^{2} \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0\\\\ \\end{pmatrix}_{\\#}^{\\;}$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "g_1_#\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 5,
   "id": "b9594cf0",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$\\begin{pmatrix} 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ \\sin(α)^{2} \\sin(β)^{2} \\sin(γ)^{2} \\sin(δ)^{2} \\sin(ζ)^{2} \\sin(ξ)^{2} r^{2}\\\\ \\end{pmatrix}_{\\#}^{\\;}$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "g_7_#\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "id": "fcb34e54",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$\\begin{pmatrix} r^{-2} \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0 \\\\ 0\\\\ \\end{pmatrix}_{\\;}^{\\#}$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "g~1~#\n"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "c1ba9dd2",
   "metadata": {},
   "source": [
    "## Levi-Civita connection\n",
    "\n",
    "The Christoffel symbols of the first kind and second kind are\n",
    "\n",
    "$$\n",
    "\\Gamma_{ijk}=\\frac12\n",
    "(\\partial_jg_{ik}+\\partial_kg_{ij}-\\partial_ig_{jk}),\n",
    "\\qquad\n",
    "\\Gamma^i{}_{jk}=g^{im}\\Gamma_{mjk}.\n",
    "$$\n",
    "\n",
    "Repeated symbolic indices are contracted by `.`.  The `withSymbols`\n",
    "block makes the dummy index local to the definition.\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 7,
   "id": "c3dc5287",
   "metadata": {},
   "outputs": [],
   "source": [
    "def Γ_i_j_k : Tensor MathValue :=\n",
    "  (1 / 2) * (∂/∂ g_i_k x~j + ∂/∂ g_i_j x~k - ∂/∂ g_j_k x~i)\n",
    "\n",
    "def Γ~i_j_k : Tensor MathValue := withSymbols [m]\n",
    "  g~i~m . Γ_m_j_k\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 8,
   "id": "c48046bb",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$-\\cos(α) \\sin(α)$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "Γ~1_2_2\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 9,
   "id": "fa8e668a",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$\\cos(α) \\sin(α)^{-1}$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "Γ~2_1_2\n"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "217655ad",
   "metadata": {},
   "source": [
    "## Riemann tensor\n",
    "\n",
    "The following definition is a direct transcription of the stated\n",
    "convention.  The two output cells sample the same coordinate\n",
    "two-plane with the first two tensor slots exchanged; their different\n",
    "coordinate factors are exactly what one expects in a non-orthonormal\n",
    "coordinate basis.\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 10,
   "id": "d0ceed4d",
   "metadata": {},
   "outputs": [],
   "source": [
    "def R~i_j_k_l : Tensor MathValue := withSymbols [m]\n",
    "  ∂/∂ Γ~i_j_l x~k - ∂/∂ Γ~i_j_k x~l\n",
    "    + Γ~m_j_l . Γ~i_m_k - Γ~m_j_k . Γ~i_m_l\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 11,
   "id": "6126b228",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$\\sin(α)^{2}$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "R~1_2_1_2\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 12,
   "id": "edc02b6b",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "$-1$"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "R~2_1_1_2\n"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "bb792202",
   "metadata": {},
   "source": [
    "## Ricci and scalar curvature\n",
    "\n",
    "Contracting the first and third Riemann indices gives\n",
    "\n",
    "$$\n",
    "\\operatorname{Ric}_{ij}=R^m{}_{imj},\n",
    "\\qquad\n",
    "\\mathcal{R}=g^{ij}\\operatorname{Ric}_{ij}.\n",
    "$$\n",
    "\n",
    "For a round $S^7$ the coordinate-free prediction is\n",
    "\n",
    "$$\n",
    "\\operatorname{Ric}=\\frac{6}{r^2}g,\n",
    "\\qquad\n",
    "\\mathcal{R}=\\frac{42}{r^2}.\n",
    "$$\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 13,
   "id": "91ed80f2",
   "metadata": {},
   "outputs": [],
   "source": [
    "def Ric_i_j : Matrix MathValue := withSymbols [m]\n",
    "  sum (contract R~m_i_m_j)\n",
    "\n",
    "def scalarCurvature : MathValue := withSymbols [i, j]\n",
    "  g~i~j . Ric_i_j\n"
   ]
  },
  {
   "cell_type": "markdown",
   "id": "9ae135a3",
   "metadata": {},
   "source": [
    "## Interpretation\n",
    "\n",
    "The sampled components are coordinate dependent, but their contractions\n",
    "recover the invariant statement: every tangent two-plane has sectional\n",
    "curvature $1/r^2$, the metric is Einstein, and the scalar curvature is\n",
    "$42/r^2$.  Factors such as $\\sin \\alpha$ vanish\n",
    "at chart poles because the coordinate frame degenerates there; the\n",
    "curvature itself remains smooth.  The Ricci and scalar-curvature definitions are present, but their full contractions are intentionally not output cells: the selected Riemann components demonstrate the constant-curvature pattern without forcing a large symbolic expansion.\n"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "Egison",
   "language": "egison",
   "name": "egison"
  },
  "language_info": {
   "codemirror_mode": "egison",
   "file_extension": ".egi",
   "mimetype": "text/x-egison",
   "name": "egison"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 5
}