(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.1' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 150516, 3766]*) (*NotebookOutlinePosition[ 186442, 4940]*) (* CellTagsIndexPosition[ 186398, 4936]*) (*WindowFrame->Normal*) Notebook[{ Cell["\<\ In this notebook, I will propose a unified field Lagrange density \ to unify gravity and EM. Here is the list of topics to be covered: I: The Lagrange density itself II: Field equations III: Classical fields IV: Dynamic metrics V: New constant velocity solutions VI. The Stress-energy tensor VII: Quantization Everything will be done using standard techniques in four dimensions. \ \>", \ "Text"], Cell[CellGroupData[{ Cell["I: The GEM Lagrange density", "Section"], Cell["\<\ What is a Lagrange density? It is a scalar function that describes \ all the mass and energy interactions per unit volume, bar none. The complete \ description of all energy as it happens to be distributed per unit volume is \ why a Lagrange density is important. Once the Lagrange density is set, \ everything else follows, including things like the field equations, \ energy/momentum, and whether the proposal can be quantized. The logic of \ mathematical physics is unbending.\ \>", "Text"], Cell["\<\ The core idea is to start with the classical Maxwell lagrange \ density, and generize it enough so that the Lagrangian can also describe \ gravity. Here is the Lagrange density that will be studied:\ \>", "Text"], Cell[BoxData[{ \(\[ScriptCapitalL] = \(-\(1\/c\)\) \((J\_q\%\[Mu] - J\_m\%\[Mu])\) A\_\[Mu] - \(1\/\(2 c\^2\)\) \[Del]\^\[Mu] A\^\[Nu] \[Del]\_\[Mu] A\_\[Nu]\), "\ \[IndentingNewLine]", \(where\), "\n", \(\[ScriptCapitalL] = The\ Lagrange\ density\), "\n", \(J\_q\%\[Mu] = electric\ charge\ contravariant\ 4 - current\ density\ \), "\n", \(J\_m\%\[Mu] = mass\ charge\ contravariant\ 4 - current\ density\ \), "\[IndentingNewLine]", \(A\_\[Mu] = gravity/EM\ covariant\ 4 - potential\), "\n", \(\[Del]\^\[Mu] A\^\[Nu] = contravariant\ 4 - derivative\ of\ a\ contravariant\ 4 - potential\)}], "Text", CellLabel->"In[17]:="], Cell["\<\ These are the units of the components of the Lagrange \ density.\ \>", "Text"], Cell[BoxData[ \(\(units = {J \[Rule] m\^\(1/2\)\/\(\(L\^\(3/2\)\) t\), V \[Rule] L\^3, q \[Rule] \(m\^\(1/2\)\ L\^\(3/2\)\)\/t, U \[Rule] L\/t, Amu \[Rule] m\^\(1/2\)\/L\^\(1/2\), Amunu \[Rule] m\^\(1/2\)\/\(t\ L\^\(1/2\)\), \@G -> L\^\(3/2\)\/\(m\^\(1/2\)\ t\), G \[Rule] L\^3\/\(m\ t\^2\), c \[Rule] L\/t, h \[Rule] \(m\ L\^2\)\/t};\)\)], "Input", CellLabel->"In[31]:="], Cell[TextData[{ "Evaluate the units of the Lagrange density: the mass and electric charge \ in motion, and the asymmetric field strength tensor. If you are unfamiliar \ with ", StyleBox["Mathematica", FontSlant->"Italic"], ", \"/.\" indicates rules for substitution, so /. units means the unit \ rules will be used to substitute into the preceding expression. It is a way \ to check that all the parts of the Lagrange density have units of ", Cell[BoxData[ \(m\/L\^3\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(J\ Amu\)\/c /. units\)], "Input", CellLabel->"In[32]:="], Cell[BoxData[ \(m\/L\^3\)], "Output", CellLabel->"Out[32]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(\((Amunu\/c\^2 /. units)\) Amunu /. units\)], "Input", CellLabel->"In[33]:="], Cell[BoxData[ \(m\/L\^3\)], "Output", CellLabel->"Out[33]="] }, Open ]], Cell[TextData[{ "The charge coupling term (J.A) represents the energy of the electric and \ mass charges in motion in a potential per unit volume. The field strength \ tensor term represents all the energy in a changing potential in flat or \ curved spacetime. The idea of treating mass technically as a charge is not \ new, but is also not widespread. One basic question is how to get the units \ such that electric and mass charge are identical. In the Gaussian system, \ the units for q can be found from Coulomb's law: ", Cell[BoxData[ \(TraditionalForm\`F = \(q\ q'\)\/R\^2\)]], ". The units of force are ", Cell[BoxData[ \(TraditionalForm\`\(m\ L\)\/t\^2\)]], ", so ", Cell[BoxData[ \(TraditionalForm\`q\^2\)]], " = ", Cell[BoxData[ FormBox[ FractionBox[ RowBox[{"m", " ", FormBox[\(L\^3\), "TraditionalForm"]}], \(t\^2\)], TraditionalForm]]], ", or ", Cell[BoxData[ \(TraditionalForm\`q = \@\(m\ L\^3\)\/t\)]], ". Odd, but true. Determine the units of ", Cell[BoxData[ \(TraditionalForm\`\@G\ m\)]], ": ", Cell[BoxData[ FormBox[ RowBox[{ SqrtBox[ FractionBox[\(L\^3\), RowBox[{"m", FormBox[\(t\^2\), "TraditionalForm"]}]]], " ", "m"}], TraditionalForm]]], " = ", Cell[BoxData[ \(TraditionalForm\`\@\(m\ L\^3\)\/t\)]], " so the units of ", Cell[BoxData[ \(TraditionalForm\`q\)]], " and ", Cell[BoxData[ \(TraditionalForm\`\@G\ m\)]], " are identical. \"", Cell[BoxData[ \(TraditionalForm\`\@G\ m\)]], "\" will be referred to as \"mass charge\" so that the language parallels \ electric charge. " }], "Text"], Cell[TextData[{ "Half of the terms in this Lagrange density are part of the standard \ classical Lagrange density for EM: the electric current density coupling to \ the potential field (-", Cell[BoxData[ \(J\_q\%\[Mu]\ \ A\_\[Mu]\)]], ") and the antisymmetric electromagnetic field strength tensor (", Cell[BoxData[ FormBox[ RowBox[{\(F\^\[Mu]\[Nu]\), "=", RowBox[{ RowBox[{ FormBox[\(\[PartialD]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "-", " ", RowBox[{ FormBox[\(\[PartialD]\^\[Nu]\), "TraditionalForm"], \(A\^\[Mu]\)}]}]}], TraditionalForm]]], ") which gets contracted with itself. " }], "Text"], Cell[TextData[{ "One new term is a mass current density coupling to the same potential \ field (+", Cell[BoxData[ \(J\_m\%\[Mu]\ \ A\_\[Mu]\)]], "). One might wonder why ", Cell[BoxData[ \(J\_q\%\[Mu]\)]], " is not redefined to include the mass current density. The reason has to \ do with the sign difference between the current density coupling and the \ field strength tensor. For EM, the same sign for both the EM current \ coupling and field strength tensor will lead to field equations where like \ electrical charges repel. For the mass charge, the difference in the sign \ between the mass current coupling and the field strength tensor will lead to \ field equations where like mass charges attract, a key property of gravity." }], "Text"], Cell[TextData[{ "The second additional term is the contraction of a symmetric field \ strength tensor (", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[\(\[Del]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "+", " ", RowBox[{ FormBox[\(\[Del]\^\[Nu]\), "TraditionalForm"], \(A\^\[Mu]\)}]}], TraditionalForm]]], "). In order to transform like a tensor, it requires covariant derivatives \ (\"\[Del]\") unlike the antisymmetric tensor's exterior derivative (\"\ \[PartialD]\"). The covariant derivative is a way to say the 4-derivative \ depends on how a metric changes. The exterior derivative is unaffected by a \ metric changing. Why the difference? A metric is a symmetric tensor. Any \ changes in the metric will only show up in the symmetric tensor. " }], "Text"], Cell[TextData[{ "Let's think about the symmetry of the field strength tensors. One type of \ symmetry is about the order of the indices. If \[Mu] changes places with \ \[Nu], the symmetric tensor (", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[\(\[Del]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "+", " ", RowBox[{ FormBox[\(\[Del]\^\[Nu]\), "TraditionalForm"], \(A\^\[Mu]\)}]}], TraditionalForm]]], ") will not be changed, but all the signs in the antisymmetric tensor (", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[\(\[PartialD]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "-", " ", RowBox[{ FormBox[\(\[PartialD]\^\[Nu]\), "TraditionalForm"], \(A\^\[Mu]\)}]}], TraditionalForm]]], ") would have to be flipped. This may be why there is one charge for mass \ and two for electricity. The asymmetric tensor ", Cell[BoxData[ \(\[Del]\^\[Mu] A\^\[Nu]\)]], " does not have a simple relationship with ", Cell[BoxData[ \(\[Del]\^\[Nu] A\^\[Mu]\)]], ". It is also called reducible because it can be represented by the \ irreducible symmetric and antisymmetric field strength tensors. " }], "Text"], Cell[TextData[{ "Because there is no t, x, or angles in the Lagrangian, energy, linear, and \ angular momentum will be conserved. This is a technical advantage over the \ Hilbert action of general relativity where energy cannot be defined locally. \ EM is a gauge theory, as is general relativity. Here too there is a gauge, a \ choice one must make before doing a calculation. The choice of gauge arrises \ from the definition of a covariant derivative: ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[\(\[Del]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "=", \(\[PartialD]\^\[Mu] A\^\[Nu] - \(\[CapitalGamma]\_\[Sigma]\^\ \[Mu]\[Nu]\) A\^\[Sigma]\)}], TraditionalForm]]], ". For a manifold with a torsion-free, metric compatible connection, there \ is one metric that uniquely determines the connection, as is done in general \ relativity. One has the ability to choose a gauge which is about the \ relationship between changes in the potential and changes in the metric. One \ could choose to work in flat Euclidean spacetime, in which case all the \ change found in the covariant derivative will be due to the standard \ derivative term, ", Cell[BoxData[ \(TraditionalForm\`\[PartialD]\^\[Mu] A\^\[Nu]\)]], ". Or the potential could be chosen so it makes no contribution to the \ contravariant derivative, and everything depends on the change in metric, ", Cell[BoxData[ \(TraditionalForm\`\(\[CapitalGamma]\_\[Sigma]\^\[Mu]\[Nu]\) A\^\[Sigma]\)]], ". There are an infinite number of gauge choices between these two \ extremes. The potential/connection diffeomorphism is the key unifying link \ between gravity and EM. " }], "Text"], Cell["\<\ Even though I worked with asymmetric, symmetric, and antisymmetric \ tensors for a while, I still wondered about their relationships to each other \ because I have little day-to-day experience with indices. One way to see \ precisely what is going on is to start with an asymmetric tensor represented \ as a 4x4 real matrix filled with random integers: \ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"B", "=", RowBox[{"(", GridBox[{ {"1", "1", "2", "3"}, {"5", "6", "9", "8"}, {"0", "7", "11", "12"}, {"13", "0", "16", "0"} }], ")"}]}], ";"}]], "Input", CellLabel->"In[34]:="], Cell[TextData[{ "Take the transpose of this matrix to get ", Cell[BoxData[ \(TraditionalForm\`B\^\[Nu]\[Mu]\)]], ", and it should be obvious: ", Cell[BoxData[ \(TraditionalForm\`B\^\[Mu]\[Nu]\)]], " does not have any simple relationship to ", Cell[BoxData[ \(TraditionalForm\`B\^\[Nu]\[Mu]\)]], ". The challenge is to rewrite this matrix as the sum of a symmetric and \ an antisymmetric matrix. Try it!" }], "Text"], Cell[TextData[{ "Here is the simple idea: the symmetric matrix is the ", StyleBox["average", FontSlant->"Italic"], " values of the two values on opposite sides of the diagonal, and the \ antisymmetric matrix is the ", StyleBox["deviation from those average", FontSlant->"Italic"], " values: " }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[BAve\ = \(B + Transpose[B]\)\/2]\)], "Input", CellLabel->"In[35]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", "3", "1", "8"}, {"3", "6", "8", "4"}, {"1", "8", "11", "14"}, {"8", "4", "14", "0"} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[35]//MatrixForm="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[BDev\ = \(B - Transpose[B]\)\/2]\)], "Input", CellLabel->"In[36]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"0", \(-2\), "1", \(-5\)}, {"2", "0", "1", "4"}, {\(-1\), \(-1\), "0", \(-2\)}, {"5", \(-4\), "2", "0"} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[36]//MatrixForm="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(B - \((BAve\ + \ BDev)\)\)], "Input", CellLabel->"In[37]:="], Cell[BoxData[ \({{0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}\)], "Output", CellLabel->"Out[37]="] }, Open ]], Cell["\<\ Isn't that cool? Taking a transpose of the first matrix is not \ going to change an average value. Taking a transpose of the deviations from \ average will flip all the signs, but no magnitudes. The average amount of \ change symmetric matrix takes the average values off the diagonal and the \ diagonal itself. The symmetric matrix represents ten of the sixteen terms of \ the asymmetric tensor. For the antisymmetric matrix, the diagonal is all \ zeroes, and represents the remaining six terms. The average value can be \ independent of the deviation from the average.\ \>", "Text"], Cell[TextData[{ "Now we can use new words to describe the symmetric field strength tensor \ and the antisymmetric tensor. The average amount of change in the \ 4-potential is ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[\(\[Del]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "+", " ", RowBox[{ FormBox[\(\[Del]\^\[Nu]\), "TraditionalForm"], \(A\^\[Mu]\)}]}], TraditionalForm]]], ", which includes changes that occur due to a changing metric. How much \ the metric changes in involved in the gauge choice. The deviation from that \ average amount of change is the tensor ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ FormBox[\(\[PartialD]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "-", " ", RowBox[{ FormBox[\(\[PartialD]\^\[Nu]\), "TraditionalForm"], \(A\^\[Mu]\)}]}], TraditionalForm]]], ", which excludes any contribution by a changing metric. The complete \ covariant 4-derivative of a contravariant 4-potential field strength tensor \ is the average amount of change symmetric tensor plus the deviation from the \ average amount of change antisymmetric tensor." }], "Text"], Cell["\<\ In summary, the Lagrange density under study has two parts: a \ coupling term for electric and mass charge in motion in a potential, and the \ average amount of change and deviation from the average amount of change in a \ 4-potential field strength tensors.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["II: Field equations", "Section"], Cell["\<\ What does one do with a Lagrange density? It cannot be measured \ directly. Instead, by taking certain derivatives, things which are \ physically observable are found. In this section the field equations are \ derived. Field equations are used to describe the motion and distribution of \ particles in a volume of spacetime. \ \>", "Text"], Cell["\<\ How does one generate field equations? Apply the Euler-Lagrange \ equation to a Lagrange density. It is that formulaic. \ \>", "Text"], Cell["\<\ It would be better to understand how the Euler-Lagrange equation \ works its magic. Here is a sketch. Consider what would happen if the \ Lagrange density were integrated over a volume and time in curved \ spacetime:\ \>", "Text"], Cell[BoxData[ \(\[ScriptCapitalS] = \[Integral]\[ScriptCapitalL]\ \(\@\(\(-det\)\ g\)\) dV\ dt\)], "Text", CellLabel->"In[166]:="], Cell["\<\ The action is the integral of all the mass and energy interactions \ per unit volume over a volume and time. If \[ScriptCapitalL] is varied, but \ the value of the integral did not change over arbitrary times, then both a \ symmetry of the action and a conserved quantity has been found. \ \>", "Text"], Cell[TextData[{ "If the Lagrange density depends only on the potential ", Cell[BoxData[ \(TraditionalForm\`A\^\[Nu]\)]], " and the field strength tensor ", Cell[BoxData[ \(TraditionalForm\`\[Del]\_\[Mu] A\^\[Nu]\)]], " because everything else is known up to a diffeomorphism, the variation of \ the action \[ScriptCapitalS] will always be zero if:" }], "Text"], Cell[BoxData[ RowBox[{\(\[PartialD]\ \[ScriptCapitalL]\/\[PartialD]\ A\^\[Nu]\), "=", RowBox[{\(\[Del]\^\[Mu]\), RowBox[{"(", FractionBox[\(\[PartialD]\ \[ScriptCapitalL]\), RowBox[{"\[PartialD]", RowBox[{"(", FormBox[ RowBox[{ FormBox[\(\[Del]\^\[Mu]\), "TraditionalForm"], \(A\^\[Nu]\)}], "TraditionalForm"], ")"}]}]], ")"}]}]}]], "Text", CellLabel->"In[24]:="], Cell["This is the Euler-Lagrange equation. ", "Text"], Cell[TextData[{ "To get ", StyleBox["Mathematica", FontSlant->"Italic"], " to do this 19th century math requires that a few things get defined:" }], "Text"], Cell[BoxData[{\(covariantvec[ A_] := {A[\([1]\)], \(-A[\([2]\)]\), \(-A[\([3]\)]\), \ \(-A[\([4]\)]\)}\), "\n", RowBox[{\(contraD[A_]\), ":=", RowBox[{"(", GridBox[{ {\(D[A[\([1]\)], t]\), \(D[A[\([2]\)], t]\), \(D[A[\([3]\)], t]\), \(D[A[\([4]\)], t]\)}, {\(\(-c\)\ D[A[\([1]\)], x]\), \(\(-c\)\ D[A[\([2]\)], x]\), \(\(-c\)\ D[A[\([3]\)], x]\), \(\(-c\)\ D[A[\([4]\)], x]\)}, {\(\(-c\)\ D[A[\([1]\)], y]\), \(\(-c\)\ D[A[\([2]\)], y]\), \(\(-c\)\ D[A[\([3]\)], y]\), \(\(-c\)\ D[A[\([4]\)], y]\)}, {\(\(-c\)\ D[A[\([1]\)], z]\), \(\(-c\)\ D[A[\([2]\)], z]\), \(\(-c\)\ D[A[\([3]\)], z]\), \(\(-c\)\ D[A[\([4]\)], z]\)} }], ")"}]}], "\n", RowBox[{\(coD[A_]\), ":=", RowBox[{"(", GridBox[{ {\(D[A[\([1]\)], t]\), \(D[A[\([2]\)], t]\), \(D[A[\([3]\)], t]\), \(D[A[\([4]\)], t]\)}, {\(c\ D[A[\([1]\)], x]\), \(c\ D[A[\([2]\)], x]\), \(c\ D[ A[\([3]\)], x]\), \(c\ D[A[\([4]\)], x]\)}, {\(c\ D[A[\([1]\)], y]\), \(c\ D[A[\([2]\)], y]\), \(c\ D[ A[\([3]\)], y]\), \(c\ D[A[\([4]\)], y]\)}, {\(c\ D[A[\([1]\)], z]\), \(c\ D[A[\([2]\)], z]\), \(c\ D[ A[\([3]\)], z]\), \(c\ D[A[\([4]\)], z]\)} }], ")"}]}], "\n", RowBox[{\(contraDvu[A_]\), ":=", RowBox[{"(", GridBox[{ {\(D[A[\([1]\)], t]\), \(\(-c\)\ D[A[\([1]\)], x]\), \(\(-c\)\ D[A[\([1]\)], y]\), \(\(-c\)\ D[A[\([1]\)], z]\)}, {\(D[A[\([2]\)], t]\), \(\(-c\)\ D[A[\([2]\)], x]\), \(\(-c\)\ D[A[\([2]\)], y]\), \(\(-c\)\ D[A[\([2]\)], z]\)}, {\(D[A[\([3]\)], t]\), \(\(-c\)\ D[A[\([3]\)], x]\), \(\(-c\)\ D[A[\([3]\)], y]\), \(\(-c\)\ D[A[\([3]\)], z]\)}, {\(D[A[\([4]\)], t]\), \(\(-c\)\ D[A[\([4]\)], x]\), \(\(-c\)\ D[A[\([4]\)], y]\), \(\(-c\)\ D[A[\([4]\)], z]\)} }], ")"}]}], "\n", RowBox[{\(coDvu[A_]\), ":=", RowBox[{"(", GridBox[{ {\(D[A[\([1]\)], t]\), \(c\ D[A[\([1]\)], x]\), \(c\ D[A[\([1]\)], y]\), \(c\ D[A[\([1]\)], z]\)}, {\(D[A[\([2]\)], t]\), \(c\ D[A[\([2]\)], x]\), \(c\ D[A[\([2]\)], y]\), \(c\ D[A[\([2]\)], z]\)}, {\(D[A[\([3]\)], t]\), \(c\ D[A[\([3]\)], x]\), \(c\ D[A[\([3]\)], y]\), \(c\ D[A[\([3]\)], z]\)}, {\(D[A[\([4]\)], t]\), \(c\ D[A[\([4]\)], x]\), \(c\ D[A[\([4]\)], y]\), \(c\ D[A[\([4]\)], z]\)} }], ")"}]}], "\[IndentingNewLine]", \(symmetricD[A_] := contraD[A] + contraDvu[A]\), "\[IndentingNewLine]", \(antisymmetricD[ A_] := contraD[A] - contraDvu[A]\)}], "Input", CellLabel->"In[255]:=", InitializationCell->True], Cell[BoxData[ \(contractMM[A_, B_] := Sum[A[\([i, j]\)]\ B[\([i, j]\)], {i, 1, 4}, {j, 1, 4}]\)], "Input", CellLabel->"In[45]:=", InitializationCell->True], Cell["\<\ Define the gravity/EM potential, and the current densities for \ electric and mass charges:\ \>", "Text"], Cell[BoxData[ \(\(A = {\[Phi][t, x, y, z], Ax[t, x, y, z], Ay[t, x, y, z], Az[t, x, y, z]};\)\)], "Input", CellLabel->"In[46]:="], Cell[BoxData[ \(\(J\_q = {\[Rho]\_q, J\_qx, J\_qy, J\_qz};\)\)], "Input", CellLabel->"In[47]:="], Cell[BoxData[ \(\(J\_m = {\[Rho]\_m, J\_mx, J\_my, J\_mz};\)\)], "Input", CellLabel->"In[48]:="], Cell["Now we can define all the terms in the GEM Lagrangian:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Expand[\((LGEM = \(-covariantvec[J\_q - J\_m] . A\)/c - Expand[contractMM[contraD[A], coD[covariant[A]]]\/\(2\ c\^2\)])\ \) /. {\[Phi][t, x, y, z] \[Rule] \[Phi], Ax[t, x, y, z] \[Rule] Ax, Ay[t, x, y, z] \[Rule] Ay, Az[t, x, y, z] \[Rule] Az}]\)], "Input", CellLabel->"In[262]:="], Cell[BoxData[ \(\(-\(\(Ax\ J\_mx\)\/c\)\) - \(Ay\ J\_my\)\/c - \(Az\ J\_mz\)\/c + \(Ax\ \ J\_qx\)\/c + \(Ay\ J\_qy\)\/c + \(Az\ J\_qz\)\/c + \(\[Phi]\ \[Rho]\_m\)\/c - \ \(\[Phi]\ \[Rho]\_q\)\/c - 1\/2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\^2 - 1\/2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\^2 - 1\/2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\^2 + 1\/2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\^2 \ - 1\/2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\^2 - 1\/2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\^2 - 1\/2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\^2 + 1\/2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\^2 \ - 1\/2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\^2 - 1\/2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\^2 - 1\/2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\^2 + 1\/2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\^2 \ + \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\))\)\^2\/\(2\ c\^2\) + \ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\))\)\^2\/\(2\ c\^2\) + \ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\))\)\^2\/\(2\ c\^2\) - \ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\^2\/\(2\ c\^2\)\ \)], "Output", CellLabel->"Out[262]="] }, Open ]], Cell["\<\ Define functions to apply the Euler-Lagrange equations to a \ Lagrange density. The function potentialD takes the derivative of a Lagrange \ density with respect to the potential. The function fieldD takes a second \ derivative with respect to the field of a Lagrange density. [Notation is \ needed so the output looks intelligible to people.]\ \>", "Text"], Cell[BoxData[ \(<< Utilities`Notation`\)], "Input", CellLabel->"In[159]:=", CellOpen->False], Cell[BoxData[{ RowBox[{"Notation", "[", RowBox[{ TagBox[\(\[PartialD]f_\/\[PartialD]t_\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[1]\)[f_]\)[t_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{"Notation", "[", RowBox[{ TagBox[\(\[PartialD]\^n_ f_\/\[PartialD]t_\^n_\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[n_]\)[f_]\)[t_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\ f_[t_, x_, y_, z_]\/\[PartialD]t_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[1, 0, 0, 0]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\ f_[t_, x_, y_, z_]\/\[PartialD]x_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[0, 1, 0, 0]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\ f_[t_, x_, y_, z_]\/\[PartialD]y_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[0, 0, 1, 0]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\ f_[t_, x_, y_, z_]\/\[PartialD]z_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[0, 0, 0, 1]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\^n_\ f_[t_, x_, y_, z_]\/\[PartialD]t_\^n_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[n_, 0, 0, 0]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], "\n", RowBox[{ RowBox[{ RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\^n_\ f_[t_, x_, y_, z_]\/\[PartialD]x_\^n_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[0, n_, 0, 0]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\^n_\ f_[t_, x_, y_, z_]\/\[PartialD]y_\^n_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[0, 0, n_, 0]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}], RowBox[{"Notation", "[", RowBox[{ TagBox[\(\(\ \)\(\[PartialD]\^n_\ f_[t_, x_, y_, z_]\/\[PartialD]z_\^n_\)\), NotationBoxTag, TagStyle->"NotationTemplateStyle"], " ", "\[DoubleLongLeftRightArrow]", " ", TagBox[\(\(\(Derivative[0, 0, 0, n_]\)[f_]\)[t_, x_, y_, z_]\), NotationBoxTag, TagStyle->"NotationTemplateStyle"]}], "]"}]}], ";"}]}], "Input",\ CellLabel->"In[239]:=", CellOpen->False], Cell[BoxData[ \(\(potentialD[L_] := Simplify[{D[L, \[Phi][t, x, y, z]], D[L, Ax[t, x, y, z]], D[L, Ay[t, x, y, z]], D[L, Az[t, x, y, z]]}];\)\)], "Input", CellLabel->"In[169]:=", InitializationCell->True], Cell[BoxData[ RowBox[{\(fieldD[L_]\), ":=", RowBox[{"Simplify", "[", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["\[Phi]", TagBox[\((1, 0, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "t"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["\[Phi]", TagBox[\((0, 1, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "x"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["\[Phi]", TagBox[\((0, 0, 1, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "y"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["\[Phi]", TagBox[\((0, 0, 0, 1)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "z"}], "]"}]}], ",", RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ax", TagBox[\((1, 0, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "t"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ax", TagBox[\((0, 1, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "x"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ax", TagBox[\((0, 0, 1, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "y"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ax", TagBox[\((0, 0, 0, 1)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "z"}], "]"}]}], ",", RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ay", TagBox[\((1, 0, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "t"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ay", TagBox[\((0, 1, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "x"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ay", TagBox[\((0, 0, 1, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "y"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Ay", TagBox[\((0, 0, 0, 1)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "z"}], "]"}]}], ",", RowBox[{ RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Az", TagBox[\((1, 0, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "t"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Az", TagBox[\((0, 1, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "x"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Az", TagBox[\((0, 0, 1, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "y"}], "]"}], "+", RowBox[{"D", "[", RowBox[{ RowBox[{"D", "[", RowBox[{"L", ",", RowBox[{ SuperscriptBox["Az", TagBox[\((0, 0, 0, 1)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}]}], "]"}], ",", "z"}], "]"}]}]}], "}"}], "]"}]}]], "Input", CellLabel->"In[384]:=", InitializationCell->True], Cell["Apply to the GEM Lagrange density:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((\(-Simplify[Expand[c\ potentialD[LGEM]]]\) \[Equal] \(-Expand[ c\ fieldD[LGEM]]\))\) /. {\[Phi][t, x, y, z] \[Rule] \[Phi]}\)], "Input", CellLabel->"In[198]:="], Cell[BoxData[ \({\(-\[Rho]\_m\) + \[Rho]\_q, J\_mx - J\_qx, J\_my - J\_qy, J\_mz - J\_qz} \[Equal] {\(-c\)\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ \[Phi][t, x, y, z]\/\[PartialD]t\^2\)\)\/c, c\ \((\(\ \)\(\[PartialD]\^2\ Ax[t, x, y, z]\/\[PartialD]z\^2\))\) + c\ \((\(\ \)\(\[PartialD]\^2\ Ax[t, x, y, z]\/\[PartialD]y\^2\))\) + c\ \((\(\ \)\(\[PartialD]\^2\ Ax[t, x, y, z]\/\[PartialD]x\^2\))\) - \(\(\ \)\(\[PartialD]\^2\ \ Ax[t, x, y, z]\/\[PartialD]t\^2\)\)\/c, c\ \((\(\ \)\(\[PartialD]\^2\ Ay[t, x, y, z]\/\[PartialD]z\^2\))\) + c\ \((\(\ \)\(\[PartialD]\^2\ Ay[t, x, y, z]\/\[PartialD]y\^2\))\) + c\ \((\(\ \)\(\[PartialD]\^2\ Ay[t, x, y, z]\/\[PartialD]x\^2\))\) - \(\(\ \)\(\[PartialD]\^2\ \ Ay[t, x, y, z]\/\[PartialD]t\^2\)\)\/c, c\ \((\(\ \)\(\[PartialD]\^2\ Az[t, x, y, z]\/\[PartialD]z\^2\))\) + c\ \((\(\ \)\(\[PartialD]\^2\ Az[t, x, y, z]\/\[PartialD]y\^2\))\) + c\ \((\(\ \)\(\[PartialD]\^2\ Az[t, x, y, z]\/\[PartialD]x\^2\))\) - \(\(\ \)\(\[PartialD]\^2\ \ Az[t, x, y, z]\/\[PartialD]t\^2\)\)\/c}\)], "Output", CellLabel->"Out[198]="] }, Open ]], Cell["\<\ This is a 4D wave equation with two charges, one where like \ electric charges repel and another where like mass charges attract.\ \>", \ "Text"], Cell["\<\ Isolate Gauss' static law for the first 4D wave equation where the \ mass charge density approaches zero.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{\(\(-\((c\ \(potentialD[LGEM]\)[\([1]\)] /. \[Rho]\_m \[Rule] 0)\)\) \[Equal] \(-Expand[c\ \(fieldD[LGEM]\)[\([1]\)]]\)\), "/.", " ", RowBox[{ RowBox[{ SuperscriptBox["\[Phi]", TagBox[\((2, 0, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}], "\[Rule]", "0"}]}]], "Input", CellLabel->"In[199]:="], Cell[BoxData[ \(\[Rho]\_q \[Equal] \(-c\)\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\)\)], "Output", CellLabel->"Out[199]="] }, Open ]], Cell["\<\ Isolate Newton's field equation for gravity for the first 4D wave \ equation for the situation where the electric charge density goes to zero and \ the second time derivative of phi is zero.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{\(-\((c\ \(potentialD[LGEM]\)[\([1]\)] /. \[Rho]\_q \[Rule] 0)\)\), "\[Equal]", RowBox[{"-", RowBox[{"(", RowBox[{\(Expand[c\ \(fieldD[LGEM]\)[\([1]\)]]\), "/.", " ", RowBox[{ RowBox[{ SuperscriptBox["\[Phi]", TagBox[\((2, 0, 0, 0)\), Derivative], MultilineFunction->None], "[", \(t, x, y, z\), "]"}], "\[Rule]", "0"}]}], ")"}]}]}]], "Input", CellLabel->"In[200]:="], Cell[BoxData[ \(\(-\[Rho]\_m\) \[Equal] \(-c\)\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\)\)], "Output", CellLabel->"Out[200]="] }, Open ]], Cell["\<\ This the mass charge density, not mass density. This must be the \ case for the units to be consistent using the same gravity/EM potential. It \ is a fun exercise to apply these two equations to a proton point charge at \ 1cm. The mass charge is something like 13 orders of magnitude smaller than \ the electric charge, and we only can measure the electric charge to ten \ significant digits.\ \>", "Text"], Cell["\<\ \"General Gauss' law\" is my name for the covariant unified field \ law modeled on the one from EM:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(-c\)\ \(potentialD[LGEM]\)[\([1]\)] \[Equal] \(-Expand[ c\ \(fieldD[LGEM]\)[\([1]\)]]\)\)], "Input", CellLabel->"In[201]:="], Cell[BoxData[ \(\(-\[Rho]\_m\) + \[Rho]\_q \[Equal] \(-c\)\ \((\(\ \)\(\[PartialD]\^2\ \ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ \[Phi][t, x, y, z]\/\[PartialD]t\^2\)\)\/c\)], "Output", CellLabel->"Out[201]="] }, Open ]], Cell["\<\ The covariant form is expected for Gauss' law, but is significant \ news for Newton's law of gravity.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["III: Classical fields", "Section"], Cell[TextData[{ "The long name \"EField\" for E must be used since E means 2.718... to \ Mathematica. Define the five classical fields that constitute the asymmetric \ tensor ", Cell[BoxData[ \(TraditionalForm\`\[Del]\^\[Mu] A\^\[Nu]\)]], ":" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(Efield = {\(-D[Ax[t, x, y, z], t]\) - c\ D[\[Phi][t, x, y, z], x], \(-D[Ay[t, x, y, z], t]\) - c\ D[\[Phi][t, x, y, z], y], \(-D[Az[t, x, y, z], t]\) - c\ D[\[Phi][t, x, y, z], z]}\), "\[IndentingNewLine]", \(e = {D[Ax[t, x, y, z], t] - c\ D[\[Phi][t, x, y, z], x], D[Ay[t, x, y, z], t] - c\ D[\[Phi][t, x, y, z], y], D[Az[t, x, y, z], t] - c\ D[\[Phi][t, x, y, z], z]}\), "\[IndentingNewLine]", \(B = c\ Curl[{Ax[t, x, y, z], Ay[t, x, y, z], Az[t, x, y, z]}]\), "\[IndentingNewLine]", \(b = \(-c\)\ {D[Ay[t, x, y, z], z] + D[Az[t, x, y, z], y], \(+D[Ax[t, x, y, z], z]\) + D[Az[t, x, y, z], x], D[Ax[t, x, y, z], y] + D[Ay[t, x, y, z], x]}\), "\[IndentingNewLine]", \(g = {D[\[Phi][t, x, y, z], t], \(-c\)\ D[Ax[t, x, y, z], x], \(-c\)\ D[Ay[t, x, y, z], y], \(-c\)\ D[Az[t, x, y, z], z]}\)}], "Input", CellLabel->"In[202]:="], Cell[BoxData[ \({\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\) - \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\), \(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][ t, x, y, z]\/\[PartialD]y\))\) - \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\), \(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][ t, x, y, z]\/\[PartialD]z\))\) - \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)}\)], "Output", CellLabel->"Out[202]="], Cell[BoxData[ \({\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\) + \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\), \(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][ t, x, y, z]\/\[PartialD]y\))\) + \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\), \(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][ t, x, y, z]\/\[PartialD]z\))\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)}\)], "Output", CellLabel->"Out[203]="], Cell[BoxData[ \({c\ \((\(-\((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\)\))\), c\ \((\(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\)\) - \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\)\))\), c\ \((\(-\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\) + \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\)\))\)}\)], "Output", CellLabel->"Out[204]="], Cell[BoxData[ \({\(-c\)\ \((\(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\)\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\)\))\), \(-c\)\ \((\(\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]z\)\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\)\))\), \(-c\)\ \((\(\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]y\)\) + \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\)\))\)}\)], "Output", CellLabel->"Out[205]="], Cell[BoxData[ \({\(\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\)\), \(-c\)\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\), \(-c\)\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\), \(-c\)\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)}\)], "Output", CellLabel->"Out[206]="] }, Open ]], Cell["\<\ Write out the antisymmetric (E + B), symmetric (e + b + g), and a \ symmetric tensors (all) in terms of the individual components.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[antisymmetricD[A]]\)], "Input", CellLabel->"In[263]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ { "0", \(c\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\) + \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\)\), \(c\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]y\))\) + \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\)\), \(c\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]z\))\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\) - \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\)\), "0", \(c\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\) - c\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), \(c\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\) - c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\) - \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\) + c\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), "0", \(c\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\) - c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\) - \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\) + c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\) + c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\), "0"} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[263]//MatrixForm="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[symmetricD[A]]\)], "Input", CellLabel->"In[264]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\) + \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\) + \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\) + \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-2\)\ c\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\) - c\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\) - c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\) + \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\) - c\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-2\)\ c\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\) - c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\) + \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\) - c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\) - c\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\), \(\(-2\)\ c\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[264]//MatrixForm="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(\n\)\(Simplify[ MatrixForm[\((symmetricD[A] + antisymmetricD[A])\)/2]]\)\)\)], "Input", CellLabel->"In[265]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\)\), \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\), \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\), \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[265]//MatrixForm="] }, Open ]], Cell["\<\ To do div, grad, curl and all that requires the vector analysis \ package:\ \>", "Text"], Cell[BoxData[ \(<< Calculus`VectorAnalysis`\)], "Input", CellLabel->"In[65]:=", InitializationCell->True], Cell[BoxData[ \(\(SetCoordinates[Cartesian[x, y, z]];\)\)], "Input", CellLabel->"In[66]:=", InitializationCell->True], Cell[TextData[{ "To get the signs correct, it is vital to note one is using a contravariant \ derivative ", Cell[BoxData[ \(TraditionalForm\`\((\[Del]\^\[Mu]\)\)]], ") to contract with the field strength tensor (", Cell[BoxData[ \(TraditionalForm\`\[Del]\_\[Nu] A\^\[Nu]\)]], "). The operators contraDiv and contraCurl take this into account. Here is \ the GEM version of a unified Gauss' law:" }], "Text"], Cell[BoxData[{ \(symcurl[{a_, b_, c_}] := {D[b, z] + D[c, y], D[c, x] + D[a, z], D[a, y] + D[b, x]}\), "\n", \(grad3[{a_, b_, c_, d_}] := {D[b, x], D[c, y], D[d, z]}\), "\n", \(contraGrad3[v_] := \(-grad3[v]\)\)}], "Input", CellLabel->"In[280]:="], Cell[CellGroupData[{ Cell[BoxData[ \(\((J\_q - J\_m)\)[\([1]\)] \[Equal] Expand[\(c\/2\) \((Div[Efield] + Div[e])\) + D[g[\([1]\)], t]\/c]\)], "Input", CellLabel->"In[273]:="], Cell[BoxData[ \(\(-\[Rho]\_m\) + \[Rho]\_q \[Equal] \(-c\^2\)\ \((\(\ \ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\^2\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\^2\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ \[Phi][t, x, y, z]\/\[PartialD]t\^2\)\)\/c\)], "Output", CellLabel->"Out[273]="] }, Open ]], Cell["\<\ These sets of substitution rules are required to set DivE = 0 and \ Div e = 0:\ \>", "Text"], Cell[BoxData[{ \(\(noEfield = {D[Ax[t, x, y, z], t] -> D[\[Phi][t, x, y, z], x], D[Ay[t, x, y, z], t] -> D[\[Phi][t, x, y, z], y], D[Az[t, x, y, z], t] -> D[\[Phi][t, x, y, z], z]};\)\), "\n", \(\(noe = {D[Ax[t, x, y, z], t] \[Rule] \(-D[\[Phi][t, x, y, z], x]\), D[Ay[t, x, y, z], t] \[Rule] \(-D[\[Phi][t, x, y, z], y]\), D[Az[t, x, y, z], t] \[Rule] \(-D[\[Phi][t, x, y, z], z]\)};\)\), "\n", \(\(nogt = {D[\[Phi][t, x, y, z], t] \[Rule] 0};\)\)}], "Input", CellLabel->"In[275]:="], Cell["\<\ If there is no divergence of the E field, no dynamic g, and no \ electric charge density, Newton's field equations for gravity results.\ \>", \ "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(\(-\[Rho]\_m\) \[Equal] Expand[\(c\/2\) \((Div[Efield] + Div[e])\) + \(1\/c\) D[g[\([1]\)]]] /. \[Rho]\_q \[Rule] 0\) /. noEfield\) /. nogt\)], "Input", CellLabel->"In[278]:="], Cell[BoxData[ \(\(-\[Rho]\_m\) \[Equal] \(-c\^2\)\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\^2\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\^2\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\)\)], "Output", CellLabel->"Out[278]="] }, Open ]], Cell["\<\ If there is no divergence of the symmetric e filed and m is zero, \ Gauss' law results.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(\((J\_q - J\_m)\)[\([1]\)] == Simplify[\(1\/2\) \((Div[Efield] + Div[e])\) + D[g[\([1]\)], t]\/c] /. \[Rho]\_m \[Rule] 0\) /. noe\)], "Input",\ CellLabel->"In[279]:="], Cell[BoxData[ \(\[Rho]\_q \[Equal] \(-c\)\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ \[Phi][t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ \[Phi][t, x, y, z]\/\[PartialD]t\^2\)\)\/c\)], "Output", CellLabel->"Out[279]="] }, Open ]], Cell["Ampere's Law:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \({\((J\_q - J\_m)\)[\([2]\)], \((J\_q - J\_m)\)[\([3]\)], \((J\_q - J\_m)\)[\([4]\)]} == Simplify[\(1\/2\) \((D[\(-Efield\), t]\/c + D[e, t]\/c + Curl[B] + symcurl[b])\) + grad3[g]]\)], "Input", CellLabel->"In[292]:="], Cell[BoxData[ \({\(-J\_mx\) + J\_qx, \(-J\_my\) + J\_qy, \(-J\_mz\) + J\_qz} \[Equal] {\(-c\)\ \((\(\ \)\(\[PartialD]\^2\ Ax[t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ Ax[t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ Ax[t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ Ax[t, x, y, z]\/\[PartialD]t\^2\)\)\/c, \(-c\)\ \((\(\ \)\(\[PartialD]\^2\ Ay[t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ Ay[t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ Ay[t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ Ay[t, x, y, z]\/\[PartialD]t\^2\)\)\/c, \(-c\)\ \((\(\ \)\(\[PartialD]\^2\ Az[t, x, y, z]\/\[PartialD]z\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ Az[t, x, y, z]\/\[PartialD]y\^2\))\) - c\ \((\(\ \)\(\[PartialD]\^2\ Az[t, x, y, z]\/\[PartialD]x\^2\))\) + \(\(\ \)\(\[PartialD]\^2\ \ Az[t, x, y, z]\/\[PartialD]t\^2\)\)\/c}\)], "Output", CellLabel->"Out[292]="] }, Open ]], Cell["The homogeneous Maxwell equations", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[Div[B]]\)], "Input", CellLabel->"In[293]:="], Cell[BoxData[ \(0\)], "Output", CellLabel->"Out[293]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[Curl[Efield] + D[B, t]\/c]\)], "Input", CellLabel->"In[294]:="], Cell[BoxData[ \({0, 0, 0}\)], "Output", CellLabel->"Out[294]="] }, Open ]], Cell["\<\ There are no gravitational analogs to the homogeneous Maxwell \ equations.\ \>", "Text"], Cell[CellGroupData[{ Cell["IV: Dynamics Metrics", "Subsection"], Cell["\<\ All of the equations written so far have been manifestly covariant, \ except for the static laws. This means that their form will not change no \ matter what metric is used. The equations will not change their form no \ matter how the metric changes throughout the spacetime manifold. The metric \ may or may not satisfy the Einstein field equations: either way, the field \ equations remain the same. Although it is natural to presume all the field \ equations were written with a flat Minkowski metric, technically that does \ not have to be the case.\ \>", "Text"], Cell["\<\ In this section, I will show two different roads to a dynamic \ metric which is consistent with experimental tests of weak field gravity. The \ first approach looks at Gauss' law when the derivatives are treated as \ covariant derivatives. The second road to the identical metric involves \ finding a solution to the wave equation, plugging that into a force law, and \ rearranging the result to look like a metric.\ \>", "Text"], Cell["\<\ Consider a static, spherically symmetric, system in a vacuum. The \ Gauss-like law for this proposal is this:\ \>", "Text"], Cell[BoxData[ \(\(1\/2\) \((\[Del]\(\(.\)\(E\)\) + \[Del]\(\(.\)\(e\)\))\) = \(\[Del]\_\ \[Mu]\((\[PartialD]\^\[Mu] A\^0 + \[PartialD]\^0 A\^\[Mu] - 2 \( \[CapitalGamma]\_\[Sigma]\^\[Mu]0\) A\^\[Sigma])\) = 0\)\)], "Text"], Cell["\<\ Choose a potential such that the derivative of the potential \ happens to be zero. This is effectively a choice of gauge so that the dynamic \ metric contains all the information about the mass and electric charges in \ the system. Under these conditions, calculate the divergence of the \ Christoffel symbol.\ \>", "Text"], Cell[BoxData[ \(\(\(\(\[EmptyDownTriangle]\[CapitalGamma]\_\[Sigma]\)\(\ \)\)\^i0\) A\^\[Sigma] = \(1\/2\) \[EmptyDownTriangle]\ \(g\_\(\[Sigma]\ \[Beta]\ \)\) \((g\^\(\[Beta]\ i, 0\) + g\^\(0\ \[Beta], i\) - g\^\(i\ 0, \[Beta]\))\) A\^\[Sigma]\)], "Text"], Cell["\<\ The first term drops because the metric is static. The third term \ drops if the metric is diagonal. Beta must equal 0 for the metric to be \ non-zero.\ \>", "Text"], Cell["\<\ Now we need to \"guess\" a metric that will solve this equation. \ The metric must reduce to the Minkowski metric for a small mass. It must \ solve a Poisson-like equation. So a metric with exponentials along the \ diagonal, with a 1/R in the potential, might work. Here is the exponential \ metric:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"metric", "=", RowBox[{"(", GridBox[{ {\(E\^\(\((\(\@G\) q - G\ M)\)\/\(\(c\^2\) \@\(x\^2 + y\^2 + \ z\^2\)\)\)\), "0", "0", "0"}, { "0", \(-E\^\(\(2 \((\(-\@G\) q - G\ M)\)\)\/\(\(c\^2\) \ \@\(x\^2 + y\^2 + z\^2\)\)\)\), "0", "0"}, {"0", "0", \(-E\^\(\(2 \((\(-\@G\) q - G\ M)\)\)\/\(\(c\^2\) \ \@\(x\^2 + y\^2 + z\^2\)\)\)\), "0"}, {"0", "0", "0", \(-E\^\(\(2 \((\(-\@G\) q - G\ M)\)\)\/\(\(c\^2\) \ \@\(x\^2 + y\^2 + z\^2\)\)\)\)} }], ")"}]}], ";"}]], "Input", CellLabel->"In[82]:="], Cell[CellGroupData[{ Cell[BoxData[ \(g00 = metric[\([1, 1]\)]\)], "Input", CellLabel->"In[83]:="], Cell[BoxData[ \(\[ExponentialE]\^\(\(\(-G\)\ M + \@G\ q\)\/\(c\^2\ \@\(x\^2 + y\^2 + \ z\^2\)\)\)\)], "Output", CellLabel->"Out[83]="] }, Open ]], Cell["This is a singular solution:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(\[IndentingNewLine]\)\(Simplify[\(-\(c\^2\/\(2 \@ G\)\)\) \((D[ 1\/g00\ D[g00, x], x] + D[\(1\/g00\) D[g00, y], y] + D[1\/g00\ D[g00, z], z])\)]\)\)\)], "Input", CellLabel->"In[295]:="], Cell[BoxData[ \(0\)], "Output", CellLabel->"Out[295]="] }, Open ]], Cell[TextData[{ "If instead, the gauge we had chosen a flat, Euclidean metric, then the \ equation for the mass charge density would have been a Poisson equation, ", Cell[BoxData[ \(\[Rho]\_m = \[Del]\^2 \[Phi]\)]], ", which has the singular charge/R solution." }], "Text"], Cell["\<\ As an added check, use a tensor notebook written by Mathhew \ Headrick of MIT's Center for Theoretical Physics to confirm the \ calculation:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(coord = {t, x, y, z};\)\), "\[IndentingNewLine]", \(<< diffgeo5.m\), "\[IndentingNewLine]", \(Sum[ Simplify[D[\(Christoffel[\([i, 1]\)]\)[\([1]\)], t] + D[\(Christoffel[\([i, 1]\)]\)[\([2]\)], x] + D[\(Christoffel[\([i, 1]\)]\)[\([3]\)], y] + D[\(Christoffel[\([i, 1]\)]\)[\([4]\)], z]], {i, 4}]\)}], "Input", CellLabel->"In[302]:="], Cell[BoxData[ \(0\)], "Output", CellLabel->"Out[304]="] }, Open ]], Cell[TextData[StyleBox[" I like to confirm the result was not trivial \ (meaning all the components were not zero):", FontSlant->"Plain"]], "Text", FontSlant->"Italic"], Cell[CellGroupData[{ Cell[BoxData[ \(Table[\(Christoffel[\([i, 1]\)]\)[\([1]\)], {i, 4}]\)], "Input", CellLabel->"In[305]:="], Cell[BoxData[ \({0, \(\[ExponentialE]\^\(\(G\ M + 3\ \@G\ q\)\/\(c\^2\ \@\(x\^2 + y\^2 \ + z\^2\)\)\)\ \@G\ \((\@G\ M - q)\)\ x\)\/\(2\ c\^2\ \((x\^2 + y\^2 + z\^2)\)\ \^\(3/2\)\), \(\[ExponentialE]\^\(\(G\ M + 3\ \@G\ q\)\/\(c\^2\ \@\(x\^2 + \ y\^2 + z\^2\)\)\)\ \@G\ \((\@G\ M - q)\)\ y\)\/\(2\ c\^2\ \((x\^2 + y\^2 + \ z\^2)\)\^\(3/2\)\), \(\[ExponentialE]\^\(\(G\ M + 3\ \@G\ q\)\/\(c\^2\ \ \@\(x\^2 + y\^2 + z\^2\)\)\)\ \@G\ \((\@G\ M - q)\)\ z\)\/\(2\ c\^2\ \((x\^2 \ + y\^2 + z\^2)\)\^\(3/2\)\)}\)], "Output", CellLabel->"Out[305]="] }, Open ]], Cell["\<\ [A personal note: I had first derived the exponential metric in the \ way outlined in the next part of this notebook. Then a mere four years later, \ realized that the divergence of the Christoffel symbol had to return the mass \ density. Having never calculated a Christoffel symbol for any metric, all of \ my work for four years was on the line, in an equation I did not know how to \ calculate! If it did not work out, then I would have to tell everyone this \ line of research was wrong. Needless to say, I was relieved when the result \ turned out correctly.]\ \>", "Text"], Cell[TextData[{ "The best known show-stopping problem with a rank one field equation \ originates from solutions to the 4D wave equation, ", Cell[BoxData[ \(TraditionalForm\`Jq\^\[Mu] - Jm\^\[Mu] = \[Square]\^2 A\^\[Mu]\)]], ". A class of solutions has the form of an inverse distance squared. To \ generate a force from such a potential, take the derivative. The resulting \ force law has an inverse distance cubed dependence, so this potential is \ obviously not physical. Newtonian gravity is not an inverse cube force law, \ never was, never will be." }], "Text"], Cell[TextData[{ "It has been shown what conditions generate Newton's field equations, ", Cell[BoxData[ \(TraditionalForm\`Jm\^0 = \[Del]\^2 A\^0\)]], ". A potential that solves this equation has an inverse distance \ dependence, so the spatial derivative will be an inverse square, the correct \ form needed for a gravitational force law. Imagine that ", Cell[BoxData[ \(TraditionalForm\`\[PartialD]\^2 \[Phi]\/\[PartialD]t\^2\)]], " is an incredibly small, but non-zero number. There should be a smooth \ transition from the zero to non-zero situation, not a dramatic breakdown from \ inverse distance squared to an inverse cubed force law. Gravity is far weaker \ than the other three known forces. Spacetime is hardly curved at all by the \ mass charge around us. This suggests perturbation theory should be applied \ to the problem. Given the way the Earth has wobbled around the Sun for four \ billion years, that kind of motion suggests a simple harmonic oscillator of \ some sort. The potential must solve the field equations. The derivative of \ the potential must under classical conditions have a ", Cell[BoxData[ \(TraditionalForm\`M\/R\^2\)]], " dependence. One possibility would involve a simple harmonic oscillator, \ with a spring constant related directly to the source mass (", Cell[BoxData[ \(TraditionalForm\`k = \(G\ M\)\/c\^2\)]], " has units of L), over a distance squared (units of L^2). If so, the \ derivative of the potential would have units of inverse distance. A \ dimensionless potential would have a spatial derivative with units of inverse \ distance. The hunt is on for a dimensionless perturbation that solves the \ field equations. A historical note: when people first worked with the 4D \ wave equation in the eighteen hundreds, they would not have considered the \ notion of geometric length for a mass, an idea that arose from general \ relativity." }], "Text"], Cell["\<\ Let's try and keep this as simple as possible, without being too \ simple. The idea is to study something a small step away from classical \ Newtonian gravitational physics - neutral, spherically symmetric, not \ rotating, a 1/R potential - with a modification to include a small \ contribution from time (translation: |R| >>> |ct|, but ct is not zero). One \ such potential that solves the vacuum field equations is:\ \>", "Text"], Cell[BoxData[ \(\(a1 = {\(\(\@G\) h/c\^2\)\/\(x\^2 + y\^2 + z\^2 - t\^2\), 0, 0, 0};\)\)], "Input", CellLabel->"In[306]:="], Cell[BoxData[ \(test[potential_] := Simplify[{D[potential[\([1]\)], {t, 2}] - D[potential[\([1]\)], {x, 2}] - D[potential[\([1]\)], {y, 2}] - D[potential[\([1]\)], {z, 2}], D[potential[\([2]\)], {t, 2}] - D[potential[\([2]\)], {x, 2}] - D[potential[\([2]\)], {y, 2}] - D[potential[\([2]\)], {z, 2}], D[potential[\([3]\)], {t, 2}] - D[potential[\([3]\)], {x, 2}] - D[potential[\([3]\)], {y, 2}] - D[potential[\([3]\)], {z, 2}], D[potential[\([4]\)], {t, 2}] - D[potential[\([4]\)], {x, 2}] - D[potential[\([4]\)], {y, 2}] - D[potential[\([4]\)], {z, 2}]}]\)], "Input", CellLabel->"In[307]:=", InitializationCell->True], Cell[CellGroupData[{ Cell[BoxData[ \(test[a1]\)], "Input", CellLabel->"In[308]:="], Cell[BoxData[ \({0, 0, 0, 0}\)], "Output", CellLabel->"Out[308]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(\@G\) h\)\/\(\(c\^2\) L\^2\) /. units\)], "Input", CellLabel->"In[92]:="], Cell[BoxData[ \(\@m\/\@L\)], "Output", CellLabel->"Out[92]="] }, Open ]], Cell[TextData[{ "This is a well known result for 4D waves - an inverse distance squared \ solves the equation instead of an inverse distance like the 3D Poisson \ equation. It is interesting that Planck's constant h is required to get the \ units correct since the presence of this constant is a sign of the domain of \ quantum mechanics. The goal is to study a potential with the form of a \ normalized simple harmonic oscillator. Do these steps together: create a \ small linear perturbation, and normalize the potential to the non-perturbed \ distance. [", Cell[BoxData[ \(TraditionalForm\`\[Sigma]\^2\)]], " is the Lorentz-invariant distance interval, ", Cell[BoxData[ \(x\^2 + y\^2 + z\^2 - \(c\^2\) t\^2\)]], "]:" }], "Text"], Cell[BoxData[ \(\(a2 = {\(c\/\@G\)\/\(\((1 + \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \ \((\(k\ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 \ - \((1 + \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\), 0, 0, 0};\)\)], "Input", CellLabel->"In[309]:="], Cell[CellGroupData[{ Cell[BoxData[ \(test[a2]\)], "Input", CellLabel->"In[310]:="], Cell[BoxData[ \({0, 0, 0, 0}\)], "Output", CellLabel->"Out[310]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(c\/\@G /. units\)], "Input", CellLabel->"In[95]:="], Cell[BoxData[ \(L\/\(\@\(L\^3\/\(m\ t\^2\)\)\ t\)\)], "Output", CellLabel->"Out[95]="] }, Open ]], Cell[TextData[{ "The potential a2 is a perturbation normalized to itself, using different \ constants to keep the units consistent. Planck's constant is no longer \ required, indicating the problem has gone back to the a relativistic gravity \ domain (there is c and G). The potential contains a shift (+1) and a \ rescaling (", Cell[BoxData[ \(TraditionalForm\`k\/\[Sigma]\^2\)]], "), neither of which affect the solution to the differential equation. \ Take the derivative of a2 with respect to time and space to first order in \ the spring constant k:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Expand[D[a2, t]] /. k\^2 \[Rule] 0\)], "Input", CellLabel->"In[96]:="], Cell[BoxData[ \({\(2\ c\ k\)\/\(\@G\ \((\(-\((1 + \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \((1 \ + \(k\ x\)\/\[Sigma]\^2)\)\^2 + \((1 + \(k\ y\)\/\[Sigma]\^2)\)\^2 + \((1 + \ \(k\ z\)\/\[Sigma]\^2)\)\^2)\)\^2\ \[Sigma]\^2\), 0, 0, 0}\)], "Output", CellLabel->"Out[96]="] }, Open ]], Cell[TextData[{ "For a small oscillation, the denominator will be approximately ", Cell[BoxData[ \(2 \[Sigma]\^2\)]], ". This substitution list will make it so (and for other cases to come)." }], "Text"], Cell[BoxData[ \(\(sublist = {k\^2 \[Rule] 0, \(-\((1 + \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \((1 + \(k\ x\)\/\ \[Sigma]\^2)\)\^2 + \((1 + \(k\ y\)\/\[Sigma]\^2)\)\^2 + \((1 + \(k\ z\)\/\ \[Sigma]\^2)\)\^2 \[Rule] 2, \(-\((1 + \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \((1 - \(k\ x\)\/\ \[Sigma]\^2)\)\^2 + \((1 - \(k\ y\)\/\[Sigma]\^2)\)\^2 + \((1 - \(k\ z\)\/\ \[Sigma]\^2)\)\^2 \[Rule] 2, \(-\((1 - \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \((1 + \(k\ x\)\/\ \[Sigma]\^2)\)\^2 + \((1 - \(k\ y\)\/\[Sigma]\^2)\)\^2 + \((1 - \(k\ z\)\/\ \[Sigma]\^2)\)\^2 \[Rule] 2, \(-\((1 - \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \((1 - \(k\ x\)\/\ \[Sigma]\^2)\)\^2 + \((1 + \(k\ y\)\/\[Sigma]\^2)\)\^2 + \((1 - \(k\ z\)\/\ \[Sigma]\^2)\)\^2 \[Rule] 2, \[IndentingNewLine]\(-\((1 - \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \ \((1 - \(k\ x\)\/\[Sigma]\^2)\)\^2 + \((1 - \(k\ y\)\/\[Sigma]\^2)\)\^2 + \ \((1 + \(k\ z\)\/\[Sigma]\^2)\)\^2 \[Rule] 2, \[IndentingNewLine]\(-\((1 - \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \ \((1 + \(k\ x\)\/\[Sigma]\^2)\)\^2 + \((1 + \(k\ y\)\/\[Sigma]\^2)\)\^2 + \ \((1 + \(k\ z\)\/\[Sigma]\^2)\)\^2 \[Rule] 2, \[IndentingNewLine]\(-\((1 - \(k\ t\)\/\[Sigma]\^2)\)\^2\) + \ \((1 - \(k\ x\)\/\[Sigma]\^2)\)\^2 + \((1 - \(k\ y\)\/\[Sigma]\^2)\)\^2 + \ \((1 - \(k\ z\)\/\[Sigma]\^2)\)\^2 \[Rule] 2};\)\)], "Input", CellLabel->"In[97]:="], Cell[CellGroupData[{ Cell[BoxData[ \(Expand[D[a2, t]] /. sublist\)], "Input", CellLabel->"In[98]:="], Cell[BoxData[ \({\(c\ k\)\/\(2\ \@G\ \[Sigma]\^2\), 0, 0, 0}\)], "Output", CellLabel->"Out[98]="] }, Open ]], Cell[TextData[{ "If the spring constant was equal to the geometric length of the source \ mass (", Cell[BoxData[ \(TraditionalForm\`k = \(G\ M\)\/c\^2\)]], " which has units of distance), then:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(Expand[D[a2, t]] /. sublist\) /. k \[Rule] \(G\ M\)\/c\^2\), "\[IndentingNewLine]", \(\(Expand[D[a2, x]] /. sublist\) /. k \[Rule] \(G\ M\)\/c\^2\), "\[IndentingNewLine]", \(\(Expand[D[a2, y]] /. sublist\) /. k \[Rule] \(G\ M\)\/c\^2\), "\[IndentingNewLine]", \(\(Expand[D[a2, z]] /. sublist\) /. k \[Rule] \(G\ M\)\/c\^2\)}], "Input",\ CellLabel->"In[99]:="], Cell[BoxData[ \({\(\@G\ M\)\/\(2\ c\ \[Sigma]\^2\), 0, 0, 0}\)], "Output", CellLabel->"Out[99]="], Cell[BoxData[ \({\(-\(\(\@G\ M\)\/\(2\ c\ \[Sigma]\^2\)\)\), 0, 0, 0}\)], "Output", CellLabel->"Out[100]="], Cell[BoxData[ \({\(-\(\(\@G\ M\)\/\(2\ c\ \[Sigma]\^2\)\)\), 0, 0, 0}\)], "Output", CellLabel->"Out[101]="], Cell[BoxData[ \({\(-\(\(\@G\ M\)\/\(2\ c\ \[Sigma]\^2\)\)\), 0, 0, 0}\)], "Output", CellLabel->"Out[102]="] }, Open ]], Cell["\<\ In the classical limit, ct -> 0 so \[Sigma] -> R. This has the \ form sought: the derivative of the potential is the source mass over a \ distance squared, so this could be a physically relevant potential.\ \>", \ "Text"], Cell[TextData[{ "Now we might understand why brilliant people in the nineteenth century \ passed by this possibility. Perturbation theory is not considered \ \"elegant\". It is merely practical. To associate a source mass M with a \ spring constant with units of distance ", Cell[BoxData[ \(TraditionalForm\`\((\(G\ M\)\/c\^2\)\)]], ") was not in the lexicon of the conceivable until the geometric approach \ of general relativity." }], "Text"], Cell["\<\ Even if researchers today were to go through that much analysis to \ get the right inverse distance dependence for the derivative of the \ potential, they would not be satisfied because experimentalists have \ confirmed small changes are required for Newton's field equation due to the \ finite speed of gravity. What I hope to find is a potential, when put in a \ force equation, can generate a metric equation consistent with all weak \ gravitational field tests of general relativity. From the modern viewpoint, \ this goal is odd, because general relativity tells us there is no force of \ gravity, only a dynamic change in the metric of spacetime. I hope to \ demonstrate a force equation whose solution for a particular potential is a \ change in the metric of spacetime. That is what the algebra will do.\ \>", \ "Text"], Cell["\<\ The first problem is to create a potential that only involves \ gravity, no EM. A way to do this is with a potential whose derivatives lie \ along the diagonal of the field strength tensor:\ \>", "Text"], Cell[BoxData[{ RowBox[{\(\[Del]\_\[Mu] A\^\[Nu]\), "=", RowBox[{"(", GridBox[{ {"f", "0", "0", "0"}, {"0", "g", "0", "0"}, {"0", "0", "h", "0"}, {"0", "0", "0", "j"} }], ")"}]}], "\[IndentingNewLine]", \(where\ f, g, h, j\ are\ the\ appropriate\ derivatives\ of\ \(\(A\^\[Nu]\)\(.\)\)\)}], \ "Text"], Cell["\<\ The normalized perturbation potential worked with earlier would \ have off-diagonal elements, and thus represent a system with mass and \ electric fields. The task is to work only with gravity. The algebraic \ question becomes how to create a potential whose derivatives only lie on the \ diagonal, nothing off-diagonal. Only first order terms of the spring \ constant k are being kept for the derivative. Changing the sign of the spring \ constant k does not affect the solution of the 4D wave differential \ equations, but does change the derivative of the potential. For example, the \ following sum of two normalized perturbation potentials solves the 4D wave \ equation:\ \>", "Text"], Cell[BoxData[ \(\(diagonalSHO = {1\/\(\((1 + \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \ \((\(k\ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 \ - \((1 + \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\) + 1\/\(\((1 - \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 - \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 - \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 + \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\), 1\/\(\((1 + \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 + \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\) + 1\/\(\((1 + \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 - \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 - \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 - \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\), 1\/\(\((1 + \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 + \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\) + 1\/\(\((1 - \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 - \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 - \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\), 1\/\(\((1 + \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 + \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\) + 1\/\(\((1 - \((\(k\ x\)\/\[Sigma]\^2)\))\)\^2 + \((1 - \((\(k\ \ y\)\/\[Sigma]\^2)\))\)\^2 + \((1 + \((\(k\ z\)\/\[Sigma]\^2)\))\)\^2 - \((1 - \ \((\(k\ t\)\/\[Sigma]\^2)\))\)\^2\)};\)\)], "Input", CellLabel->"In[103]:="], Cell[CellGroupData[{ Cell[BoxData[ \(test[diagonalSHO]\)], "Input", CellLabel->"In[104]:="], Cell[BoxData[ \({0, 0, 0, 0}\)], "Output", CellLabel->"Out[104]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[ Expand[Simplify[\(contraD[diagonalSHO] /. sublist\) /. k \[Rule] \(G\ M\)\/c\^2]]]\)], "Input", CellLabel->"In[311]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\(G\^2\ M\^2\ t\)\/\(c\^4\ \[Sigma]\^4\) + \(G\ M\)\/\(c\^2\ \ \[Sigma]\^2\)\), \(\(G\^2\ M\^2\ t\)\/\(c\^4\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ \ t\)\/\(c\^4\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ t\)\/\(c\^4\ \ \[Sigma]\^4\)\)}, {\(\(G\^2\ M\^2\ x\)\/\(c\^3\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ \ x\)\/\(c\^3\ \[Sigma]\^4\) + \(G\ M\)\/\(c\ \[Sigma]\^2\)\), \(\(G\^2\ M\^2\ \ x\)\/\(c\^3\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ x\)\/\(c\^3\ \[Sigma]\^4\)\)}, {\(\(G\^2\ M\^2\ y\)\/\(c\^3\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ \ y\)\/\(c\^3\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ y\)\/\(c\^3\ \[Sigma]\^4\) + \ \(G\ M\)\/\(c\ \[Sigma]\^2\)\), \(\(G\^2\ M\^2\ y\)\/\(c\^3\ \ \[Sigma]\^4\)\)}, {\(\(G\^2\ M\^2\ z\)\/\(c\^3\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ \ z\)\/\(c\^3\ \[Sigma]\^4\)\), \(\(G\^2\ M\^2\ z\)\/\(c\^3\ \[Sigma]\^4\)\), \ \(\(G\^2\ M\^2\ z\)\/\(c\^3\ \[Sigma]\^4\) + \(G\ M\)\/\(c\ \[Sigma]\^2\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[311]//MatrixForm="] }, Open ]], Cell["\<\ Only the terms to first order in M will make a significant \ contribution:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[ Normal[Series[ Expand[Simplify[\(contraD[diagonalSHO] /. sublist\) /. k \[Rule] \(G\ M\)\/c\^2]], {M, 0, 1}]]]\)], "Input", CellLabel->"In[312]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\(G\ M\)\/\(c\^2\ \[Sigma]\^2\)\), "0", "0", "0"}, {"0", \(\(G\ M\)\/\(c\ \[Sigma]\^2\)\), "0", "0"}, {"0", "0", \(\(G\ M\)\/\(c\ \[Sigma]\^2\)\), "0"}, {"0", "0", "0", \(\(G\ M\)\/\(c\ \[Sigma]\^2\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[312]//MatrixForm="] }, Open ]], Cell["\<\ It is ironic how much work is required to generate the identity \ matrix times a common factor.\ \>", "Text"], Cell["\<\ The force equation for mass and electric charge will have the same \ form as the Lorentz force equation for electric charge alone:\ \>", "Text"], Cell[BoxData[{ \(Lorentz\ force\ equation\ for\ EM\), "\[IndentingNewLine]", \(F = \(\(1\/c\) q\ \(U\_\[Nu]\) \((\[PartialD]\^\[Mu] A\^\[Nu] - \[PartialD]\^\[Nu] \ A\^\[Mu])\) = \(\[PartialD]\ m\ U\^\[Mu]\)\/\[PartialD]\ \ \[Tau]\ \ \ \ \ \ \ \ where\ U\^\[Nu]\ is\ the\ relativistic\ 4 - velocity\)\), "\[IndentingNewLine]", \(Lorentz\ force\ equation\ for\ GEM\), "\[IndentingNewLine]", \(F = \(\(1\/c\) \((q - \(\@G\) m)\)\ \(U\_\[Nu]\) \[Del]\^\[Mu] A\^\[Nu] = \(\[PartialD]\ m\ \ U\^\[Mu]\)\/\[PartialD]\ \[Tau]\)\)}], "Text"], Cell["\<\ Assume that there is no electric charge (q=0). Plug in the \ derivative of the normalized potential which applies only to gravity from \ above:\ \>", "Text"], Cell[BoxData[ \(contractVM[V_, M_] := {Sum[V[\([i]\)]\ M[\([1, i]\)], {i, 1, 4}], Sum[V[\([i]\)]\ M[\([2, i]\)], {i, 1, 4}], Sum[V[\([i]\)]\ M[\([3, i]\)], {i, 1, 4}], Sum[V[\([i]\)]\ M[\([4, i]\)], {i, 1, 4}]}\)], "Input", CellLabel->"In[107]:=", InitializationCell->True], Cell[BoxData[ \(\(\(v = {U\_0[\[Tau]], \(-U\_1[\[Tau]]\), \(-U\_2[\[Tau]]\), \(-U\_3[\ \[Tau]]\)};\)\(\ \)\)\)], "Input", CellLabel->"In[315]:="], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[\(-m[\[Tau]]\)\ c\ contractVM[v, Expand[contraD[diagonalSHO]] /. sublist]]\)], "Input", CellLabel->"In[316]:="], Cell[BoxData[ \({\(-\(\(c\ k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\[Sigma]\^2\)\), \(c\^2\ k\ m[\ \[Tau]]\ U\_1[\[Tau]]\)\/\[Sigma]\^2, \(c\^2\ k\ m[\[Tau]]\ U\_2[\[Tau]]\)\/\ \[Sigma]\^2, \(c\^2\ k\ m[\[Tau]]\ U\_3[\[Tau]]\)\/\[Sigma]\^2}\)], "Output", CellLabel->"Out[316]="] }, Open ]], Cell[TextData[{ "Note G has vanished. Don't worry, it is in the spring constant k. The \ relativistic force F is written in terms of a derivative with respect to the \ interval \[Tau]. \[Tau] is related to \[Sigma] by the equation ", Cell[BoxData[ \(\((c\[Tau])\)\^2 = \(-\[Sigma]\^2\)\)]], ". Spherical symmetry will be presumed from here on, so (U_1, U_2, U_3) \ will be written as U_R. Make these changes:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \({\(-\(\(c\ k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\[Sigma]\^2\)\), \(c\ k\ m[\ \[Tau]]\ U\_R[\[Tau]]\)\/\[Sigma]\^2} /. \[Sigma] \[Rule] I\ c\ \[Tau]\)], "Input", CellLabel->"In[317]:="], Cell[BoxData[ \({\(k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\(c\ \[Tau]\^2\), \(-\(\(k\ m[\[Tau]]\ \ U\_R[\[Tau]]\)\/\(c\ \[Tau]\^2\)\)\)}\)], "Output", CellLabel->"Out[317]="] }, Open ]], Cell["Apply the chain rule to the change in momentum.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(D[m[\[Tau]]\ \(U\^\[Nu]\)[\[Tau]], \[Tau]]\)], "Input", CellLabel->"In[111]:="], Cell[BoxData[ RowBox[{ RowBox[{\(\(U\^\[Nu]\)[\[Tau]]\), " ", RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}], "+", RowBox[{\(m[\[Tau]]\), " ", RowBox[{ SuperscriptBox[\(U\^\[Nu]\), "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}]}]], "Output", CellLabel->"Out[111]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(D[m[\[Tau]]\ U\_\[Mu][\[Tau]], \[Tau]]\)], "Input", CellLabel->"In[112]:="], Cell[BoxData[ RowBox[{ RowBox[{\(U\_\[Mu][\[Tau]]\), " ", RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}], "+", RowBox[{\(m[\[Tau]]\), " ", RowBox[{ SuperscriptBox[\(U\_\[Mu]\), "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}]}]], "Output", CellLabel->"Out[112]="] }, Open ]], Cell["\<\ In this section, we assume that test mass does not change in \ spacetime. To find a new constant velocity solution in a later section, this \ assumption will not be made.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{\({\(k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\(c\ \[Tau]\^2\), \(-\(\(k\ m\ \ [\[Tau]] U\_R[\[Tau]]\)\/\(c\ \[Tau]\^2\)\)\)}\), "/.", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}], "\[Rule]", "0"}], ",", \(m[\[Tau]] \[Rule] m\)}], "}"}]}]], "Input", CellLabel->"In[318]:="], Cell[BoxData[ \({\(k\ m\ U\_0[\[Tau]]\)\/\(c\ \[Tau]\^2\), \(-\(\(k\ m\ \ U\_R[\[Tau]]\)\/\(c\ \[Tau]\^2\)\)\)}\)], "Output", CellLabel->"Out[318]="] }, Open ]], Cell["\<\ Presume the equivalence principle so the gravitational test mass m \ on the left side of the force equation cancels the inertial mass m on the \ right. Solve the first order differential equations.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(DSolve[{\(k\ m\ U\_0[\[Tau]]\)\/\(c\ \[Tau]\^2\) \[Equal] m\ D[U\_0[\[Tau]], \[Tau]], \(-\(\(k\ m\ U\_R[\[Tau]]\)\/\(c\ \ \[Tau]\^2\)\)\) \[Equal] m\ D[U\_R[\[Tau]], \[Tau]]}, {U\_0[\[Tau]], U\_R[\[Tau]]}, \[Tau]]\)], "Input", CellLabel->"In[319]:="], Cell[BoxData[ \({{U\_0[\[Tau]] \[Rule] \[ExponentialE]\^\(-\(k\/\(c\ \[Tau]\)\)\)\ C[ 1], U\_R[\[Tau]] \[Rule] \[ExponentialE]\^\(k\/\(c\ \[Tau]\)\)\ \ C[2]}}\)], "Output", CellLabel->"Out[319]="] }, Open ]], Cell["\<\ The next task is to eliminate the constants of integration. \ Contract the relativistic velocity 4-vector solution.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \({\[ExponentialE]\^\(-\(k\/\(c\ \[Tau]\)\)\)\ C[ 1], \[ExponentialE]\^\(k\/\(c\ \[Tau]\)\)\ C[ 2]} . {\[ExponentialE]\^\(-\(k\/\(c\ \[Tau]\)\)\)\ C[ 1], \(-\[ExponentialE]\^\(k\/\(c\ \[Tau]\)\)\)\ C[2]}\)], "Input",\ CellLabel->"In[320]:="], Cell[BoxData[ \(\[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \[Tau]\)\)\)\ C[1]\^2 - \ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\)\ C[2]\^2\)], "Output", CellLabel->"Out[320]="] }, Open ]], Cell["In flat spacetime, k->0", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Limit[\[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \[Tau]\)\)\)\ C[1]\^2 - \ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\)\ C[2]\^2, k \[Rule] 0]\)], "Input", CellLabel->"In[321]:="], Cell[BoxData[ \(C[1]\^2 - C[2]\^2\)], "Output", CellLabel->"Out[321]="] }, Open ]], Cell["\<\ This can only be the case if the constants of integration are \ velocities in flat spacetime.\ \>", "Text"], Cell[BoxData[ \(\(flatSpacetimeConstraint = {\ C[1] \[Rule] c\ dt\/dtau, C[2] \[Rule] dR\/dtau};\)\)], "Input", CellLabel->"In[117]:="], Cell["\<\ Apply this constraint to the contracted relativistic velocity \ 4-vector solution.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \[Tau]\)\)\)\ C[1]\^2 - \ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\)\ C[2]\^2 \[Equal] c\^2 /. flatSpacetimeConstraint\)], "Input", CellLabel->"In[322]:="], Cell[BoxData[ \(\(c\^2\ dt\^2\ \[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \ \[Tau]\)\)\)\)\/dtau\^2 - \(dR\^2\ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\ \)\)\/dtau\^2 \[Equal] c\^2\)], "Output", CellLabel->"Out[322]="] }, Open ]], Cell[TextData[{ "Since perturbation theory has been used, it has already been assumed that \ the metric is close to flat, thus the contracted velocity is approximately ", Cell[BoxData[ \(TraditionalForm\`c\^2\)]], ". Multiply both sides by ", Cell[BoxData[ \(dtau\^2\/c\^2\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Expand[\((\(c\^2\ dt\^2\ \[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \ \[Tau]\)\)\)\)\/dtau\^2 - \(dR\^2\ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\ \)\)\/dtau\^2)\) dtau\^2\/c\^2] == \(c\^2\) dtau\^2\/c\^2\)], "Input", CellLabel->"In[323]:="], Cell[BoxData[ \(dt\^2\ \[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \[Tau]\)\)\) - \(dR\^2\ \ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\)\)\/c\^2 \[Equal] dtau\^2\)], "Output", CellLabel->"Out[323]="] }, Open ]], Cell[TextData[{ "The magnitude of tau will be the same as sigma (|c tau| = |sigma|~=R). To \ make the metric real, choose sigma to be imaginary, so that c\[Tau] \ \[EqualTilde] R. Make the substitutions ", Cell[BoxData[ \(\[Tau] \[Rule] \(\(R\/c\) and\ k \[Rule] GM\/c\^2\)\)]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((dt\^2\ \[ExponentialE]\^\(-\(\(2\ k\)\/\(c\ \[Tau]\)\)\) - \(dR\^2\ \ \[ExponentialE]\^\(\(2\ k\)\/\(c\ \[Tau]\)\)\)\/c\^2 /. {\[Tau] \[Rule] R\/c, \ k \[Rule] \(G\ M\)\/c\^2})\) == dtau\^2\)], "Input", CellLabel->"In[324]:="], Cell[BoxData[ \(dt\^2\ \[ExponentialE]\^\(-\(\(2\ G\ M\)\/\(c\^2\ R\)\)\) - \(dR\^2\ \ \[ExponentialE]\^\(\(2\ G\ M\)\/\(c\^2\ R\)\)\)\/c\^2 \[Equal] dtau\^2\)], "Output", CellLabel->"Out[324]="] }, Open ]], Cell["\<\ The equation has the same form as the exponential metric discussed \ earlier\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[ DiagonalMatrix[{\[ExponentialE]\^\(-\(\(2\ G\ M\)\/\(c\^2\ R\)\)\), \(-\ \ \[ExponentialE]\^\(\(2\ G\ M\)\/\(c\^2\ R\)\)\), \(-\ \ \[ExponentialE]\^\(\(2\ G\ M\)\/\(c\^2\ R\)\)\), \(-\ \[ExponentialE]\^\(\(2\ \ G\ M\)\/\(c\^2\ R\)\)\)}]]\)], "Input", CellLabel->"In[325]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\[ExponentialE]\^\(-\(\(2\ G\ M\)\/\(c\^2\ R\)\)\)\), "0", "0", "0"}, {"0", \(-\[ExponentialE]\^\(\(2\ G\ M\)\/\(c\^2\ R\)\)\), "0", "0"}, {"0", "0", \(-\[ExponentialE]\^\(\(2\ G\ M\)\/\(c\^2\ R\)\)\), "0"}, {"0", "0", "0", \(-\[ExponentialE]\^\(\(2\ G\ M\)\/\(c\^2\ R\)\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[325]//MatrixForm="] }, Open ]], Cell[TextData[Cell[BoxData[ \(Take\ the\ Taylor\ series\ expansion\ for\ a\ small\ value\ of\ the\ \ gravitational\ field\ \(\(\(G\ M\)\/\(c\^2\ R\)\)\(.\)\)\)]]], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((Series[ dt\^2\ \[ExponentialE]\^\(\(-2\)\ \[Phi]\) - dR\^2\/c\^2\ \[ExponentialE]\^\(2\ \[Phi]\), {\[Phi], 0, 2}] /. \[Phi] -> \(G\ M\)\/\(c\^2\ R\))\) == dtau\^2\)], "Input",\ CellLabel->"In[122]:="], Cell[BoxData[ RowBox[{ InterpretationBox[ RowBox[{\((\(-\(dR\^2\/c\^2\)\) + dt\^2)\), "+", \(\(\((\(-\(\(2\ dR\^2\)\/c\^2\)\) - 2\ dt\^2)\)\ G\ M\)\/\(c\^2\ R\)\), "+", \(\((\(-\(\(2\ dR\^2\)\/c\^2\)\) + 2\ dt\^2)\)\ \((\(G\ M\)\/\(c\^2\ R\))\)\^2\), "+", InterpretationBox[\(O[\(G\ M\)\/\(c\^2\ R\)]\^3\), SeriesData[ Times[ Power[ c, -2], G, M, Power[ R, -1]], 0, {}, 0, 3, 1], Editable->False]}], SeriesData[ Times[ Power[ c, -2], G, M, Power[ R, -1]], 0, { Plus[ Times[ -1, Power[ c, -2], Power[ dR, 2]], Power[ dt, 2]], Plus[ Times[ -2, Power[ c, -2], Power[ dR, 2]], Times[ -2, Power[ dt, 2]]], Plus[ Times[ -2, Power[ c, -2], Power[ dR, 2]], Times[ 2, Power[ dt, 2]]]}, 0, 3, 1], Editable->False], "\[Equal]", \(dtau\^2\)}]], "Output", CellLabel->"Out[122]="] }, Open ]], Cell["Rewrite.", "Text"], Cell[BoxData[ \(\(\((1 - 2 \( G\ M\)\/\(c\^2\ R\) + 2 \((\(G\ M\)\/\(c\^2\ R\))\)\^2)\) dt\^2 - \((1 + 2 \( G\ M\)\/\(c\^2\ R\))\) dR\^2\/c\^2 == dtau\^2;\)\)], "Input", CellLabel->"In[123]:="], Cell["\<\ The Taylor series expansion of the isotropic Schwarzschild metric \ (MTW, exercise 31.7)\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((Series[\(\((\(1 - \[Phi]\/2\)\/\(1 + \[Phi]\/2\))\)\^2\) dt\^2 - \(\((1 + \[Phi]\/2)\)\^4\) dR\^2\/c\^2, {\[Phi], 0, 2}] /. \[Phi] -> \(G\ M\)\/\(c\^2\ R\))\) == dtau\^2\)], "Input",\ CellLabel->"In[124]:="], Cell[BoxData[ RowBox[{ InterpretationBox[ RowBox[{\((\(-\(dR\^2\/c\^2\)\) + dt\^2)\), "+", \(\(\((\(-\(\(2\ dR\^2\)\/c\^2\)\) - 2\ dt\^2)\)\ G\ M\)\/\(c\^2\ R\)\), "+", \(\((\(-\(\(3\ dR\^2\)\/\(2\ c\^2\)\)\) + 2\ dt\^2)\)\ \((\(G\ M\)\/\(c\^2\ R\))\)\^2\), "+", InterpretationBox[\(O[\(G\ M\)\/\(c\^2\ R\)]\^3\), SeriesData[ Times[ Power[ c, -2], G, M, Power[ R, -1]], 0, {}, 0, 3, 1], Editable->False]}], SeriesData[ Times[ Power[ c, -2], G, M, Power[ R, -1]], 0, { Plus[ Times[ -1, Power[ c, -2], Power[ dR, 2]], Power[ dt, 2]], Plus[ Times[ -2, Power[ c, -2], Power[ dR, 2]], Times[ -2, Power[ dt, 2]]], Plus[ Times[ Rational[ -3, 2], Power[ c, -2], Power[ dR, 2]], Times[ 2, Power[ dt, 2]]]}, 0, 3, 1], Editable->False], "\[Equal]", \(dtau\^2\)}]], "Output", CellLabel->"Out[124]="] }, Open ]], Cell["Rewrite.", "Text"], Cell[BoxData[ \(\(\((1 - 2 \( G\ M\)\/\(c\^2\ R\) + 2 \((\(G\ M\)\/\(c\^2\ R\))\)\^2)\) dt\^2 - \((1 + 2 \( G\ M\)\/\(c\^2\ R\))\) dR\^2\/c\^2 == dtau\^2;\)\)], "Input", CellLabel->"In[125]:="], Cell["\<\ This is exactly the terms tested and confirmed for weak field tests \ of general relativity, so this proposal will pass all those tests. This is \ known as first-order Parametrized Post-Newtonian (1st order PPN) accuracy. I \ spoke to Clifford Will who said that tests to second order PPN accuracy are \ not being conducted or even planned. So what is the predicted difference at \ second order PPN accuracy? Reuben Epstein and Irwin Shapiro provide a formula \ (Phys. Rev. D, 22:2947, 1980):\ \>", "Text"], Cell[BoxData[ \(\[CapitalDelta]\[Theta] = \[Pi] \((2\ + 2 \[Gamma] - \[Beta] + \(3\/4\) \[Epsilon])\) \(G\^2\ M\^2\)\/\(\ \(c\^4\) R\^2\)\)], "Text"], Cell["\<\ For general relativity, \[Gamma], \[Beta] and \[Epsilon] are all \ equal to one:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\[CapitalDelta]\[Theta] = \[Pi] \((2\ + 2 \[Gamma] - \[Beta] + \(3\/4\) \[Epsilon])\) \(\(G\^2\ M\^2\)\ \/\(\(c\^4\) R\^2\)\) microarcseconds /. {\[Gamma] \[Rule] 1, \[Beta] -> 1, \[Epsilon] \[Rule] 1, M \[Rule] 1.98\ \(10\^30\) kg, R \[Rule] 6.96\ \(10\^8\) m, G \[Rule] 6.67\ \(10\^\(-11\)\) m\^3\/\(kg\ s\^2\), c \[Rule] 3\ \(10\^8\) m\/s, microarcseconds \[Rule] 1/\((\(\(2\ \[Pi]\)\/360\) \(1\/60\) \(1\/60\) 10\^\(-6\))\)}\)], "Input", CellLabel->"In[126]:="], Cell[BoxData[ \(10.801518750000001`\)], "Output", CellLabel->"Out[126]="] }, Open ]], Cell["\<\ General relativity predicts bending at the solar limb at 10.8 \ microarcseconds. The bending for the exponential metric sets \[Epsilon] equal \ to 4/3:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\[CapitalDelta]\[Theta] = \[Pi] \((2\ + 2 \[Gamma] - \[Beta] + \(3\/4\) \[Epsilon])\) \(\(G\^2\ M\^2\)\ \/\(\(c\^4\) R\^2\)\) microarcseconds /. {\[Gamma] \[Rule] 1, \[Beta] -> 1, \[Epsilon] \[Rule] 4/3, M \[Rule] 1.98\ \(10\^30\) kg, R \[Rule] 6.96\ \(10\^8\) m, G \[Rule] 6.67\ \(10\^\(-11\)\) m\^3\/\(kg\ s\^2\), c \[Rule] 3\ \(10\^8\) m\/s, microarcseconds \[Rule] 1/\((\(\(2\ \[Pi]\)\/360\) \(1\/60\) \(1\/60\) 10\^\(-6\))\)}\)], "Input", CellLabel->"In[127]:="], Cell[BoxData[ \(11.52162`\)], "Output", CellLabel->"Out[127]="] }, Open ]], Cell["\<\ The exponential unified field theory metric predicts 0.7 \ microarcseconds more bending than the Schwarzschild metric of general \ relativity.The current measurements of light bending are on the order of a \ hundred microarcseconds. At the microsecond level, other effects like the \ speed of the rotation of the Sun and its quadrupole moment come into play. \ Still this is an important milestone: the exponential metric is not a \ solution to the Einstein field equations, but could be confirmed or rejected \ on experimental grounds.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["V: Classical constant velocity solution", "Subsection"], Cell["\<\ We first need to derive Newton's gravitational force law from this \ completely relativistic one.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \({\(-\(\(c\ k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\[Sigma]\^2\)\), \(c\ k\ m[\ \[Tau]]\ U\_R[\[Tau]]\)\/\[Sigma]\^2} == {D[m[\[Tau]]\ U\_0[\[Tau]], \[Tau]], D[m[\[Tau]]\ U\_R[\[Tau]], \[Tau]]}\)], "Input", CellLabel->"In[128]:="], Cell[BoxData[ RowBox[{\({\(-\(\(c\ k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\[Sigma]\^2\)\), \(c\ \ k\ m[\[Tau]]\ U\_R[\[Tau]]\)\/\[Sigma]\^2}\), "\[Equal]", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{\(U\_0[\[Tau]]\), " ", RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}], "+", RowBox[{\(m[\[Tau]]\), " ", RowBox[{ SuperscriptBox[\(U\_0\), "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}]}], ",", RowBox[{ RowBox[{\(U\_R[\[Tau]]\), " ", RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}], "+", RowBox[{\(m[\[Tau]]\), " ", RowBox[{ SuperscriptBox[\(U\_R\), "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}]}]}], "}"}]}]], "Output", CellLabel->"Out[128]="] }, Open ]], Cell["\<\ Newton's classical force law is conservative, so the first terms of \ the above equation are zero. Presume the change in mass term contributes \ nothing. The spring constant k becomes the gravitational length of the source \ mass. The distance sigma becomes R. \ \>", "Text"], Cell[BoxData[{ \(\(conservativeForce = {U\_0[\[Tau]] \[Rule] 0, \(U\_0'\)[\[Tau]] \[Rule] 0};\)\), "\[IndentingNewLine]", \(\(noMassChange = {\(m'\)[\[Tau]] \[Rule] 0, \ m[\[Tau]] \[Rule] m};\)\), "\[IndentingNewLine]", \(\(springIsSourceMass = {k \[Rule] \(G\ M\)\/c\^2};\)\), "\ \[IndentingNewLine]", \(\(sigmaToR = {\[Sigma] \[Rule] R};\)\)}], "Input", CellLabel->"In[129]:="], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(\({\(-\(\(c\ k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\[Sigma]\^2\)\), \(c\ k\ \ m[\[Tau]]\ U\_R[\[Tau]]\)\/\[Sigma]\^2} == {D[ m[\[Tau]]\ U\_0[\[Tau]], \[Tau]], D[m[\[Tau]]\ U\_R[\[Tau]], \[Tau]]} /. noMassChange\) /. conservativeForce\) /. springIsSourceMass\) /. sigmaToR\)], "Input",\ CellLabel->"In[133]:="], Cell[BoxData[ RowBox[{\({0, \(G\ m\ M\ U\_R[\[Tau]]\)\/\(c\ R\^2\)}\), "\[Equal]", RowBox[{"{", RowBox[{"0", ",", RowBox[{"m", " ", RowBox[{ SuperscriptBox[\(U\_R\), "\[Prime]", MultilineFunction->None], "[", "\[Tau]", "]"}]}]}], "}"}]}]], "Output", CellLabel->"Out[133]="] }, Open ]], Cell["\<\ We now need to break spacetime symmetry. We can no longer use a \ relativistic 4-velocity or 4-acceleration. The question is what is now the \ appropriate derivatives and directions for those derivatives? Newton's law \ describes a static force field, so the interval tau has the same magnitude as \ the absolute value of the distance, |R|. \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \({D[t[\[Tau]], \[Tau]], c\ D[R[\[Tau]], \[Tau]]} /. {\[Tau] \[Rule] R}\)], "Input", CellLabel->"In[134]:="], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["t", "\[Prime]", MultilineFunction->None], "[", "R", "]"}], ",", RowBox[{"c", " ", RowBox[{ SuperscriptBox["R", "\[Prime]", MultilineFunction->None], "[", "R", "]"}]}]}], "}"}]], "Output",\ CellLabel->"Out[134]="] }, Open ]], Cell[TextData[{ "In classical physics, time is independent of space, so the gamma term \ here, ", Cell[BoxData[ \(\[PartialD]t\/\[PartialD]R\)]], ", is zero. The other term is a unit vector in the R direction. This says \ that change only happens along the direction of R, a reasonable statement. " }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\({D[t[\[Tau]], \[Tau]], c\^2\ D[R[\[Tau]], {\[Tau], 2}]} /. {\[Tau] \[Rule] R}\) /. \(t'\)[ R] -> 0\)], "Input", CellLabel->"In[135]:="], Cell[BoxData[ RowBox[{"{", RowBox[{"0", ",", RowBox[{\(c\^2\), " ", RowBox[{ SuperscriptBox["R", "\[Prime]\[Prime]", MultilineFunction->None], "[", "R", "]"}]}]}], "}"}]], "Output",\ CellLabel->"Out[135]="] }, Open ]], Cell[TextData[{ "This acceleration still is not classical because it contains the constant \ ", Cell[BoxData[ \(TraditionalForm\`c\^2\)]], ". One way to eliminate it is to substitute R/c->it. Do that twice, and in \ pops a minus sign, out go the c's." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(\({D[t[\[Tau]], \[Tau]], c\^2\ D[R[\[Tau]], {\[Tau], 2}]} /. {\[Tau] \[Rule] R}\) /. \(t'\)[R] -> 0\) /. \(R''\)[ R] \[Rule] \(-\(1\/c\^2\)\) \(R''\)[t]\)], "Input", CellLabel->"In[136]:="], Cell[BoxData[ RowBox[{"{", RowBox[{"0", ",", RowBox[{"-", RowBox[{ SuperscriptBox["R", "\[Prime]\[Prime]", MultilineFunction->None], "[", "t", "]"}]}]}], "}"}]], "Output",\ CellLabel->"Out[136]="] }, Open ]], Cell["\<\ This is the classical acceleration. Plug this substitutions into \ the relativistic force law:\ \>", "Text"], Cell[BoxData[{ \(\(changeOnlyAlongRhat = {U\_R[\[Tau]] \[Rule] c\ R\&~};\)\), "\[IndentingNewLine]", \(\(velocity2dRdtau = {U\_R \[Rule] \(R'\)[\[Tau]]};\)\), "\ \[IndentingNewLine]", \(\(dtau2t = {\(R''\)[\[Tau]] \[Rule] \(-\(R''\)[t]\)};\)\)}], "Input", CellLabel->"In[137]:="], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(\(\(\(\({\(-\(\(c\ k\ m[\[Tau]]\ U\_0[\[Tau]]\)\/\[Sigma]\^2\)\), \ \(c\ k\ m[\[Tau]]\ U\_R[\[Tau]]\)\/\[Sigma]\^2} == {D[ m[\[Tau]]\ U\_0[\[Tau]], \[Tau]], D[m[\[Tau]]\ U\_R[\[Tau]], \[Tau]]} /. noMassChange\) /. conservativeForce\) /. springIsSourceMass\) /. sigmaToR\) /. changeOnlyAlongRhat\) /. velocity2dRdtau\) /. dtau2t\)], "Input", CellLabel->"In[140]:="], Cell[BoxData[ RowBox[{\({0, \(G\ m\ M\ \(R\&~\)\)\/R\^2}\), "\[Equal]", RowBox[{"{", RowBox[{"0", ",", RowBox[{"m", " ", RowBox[{ RowBox[{"(", RowBox[{"-", RowBox[{ SuperscriptBox["R", "\[Prime]\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], ")"}], "[", "\[Tau]", "]"}]}]}], "}"}]}]], "Output", CellLabel->"Out[140]="] }, Open ]], Cell["This is Newton's gravitational force law.", "Text"], Cell["\<\ One interesting thing to explore is the consequences of not \ assuming the distribution of mass in fact does change in spacetime. The \ derivation relied on assume a static system, so the change in mass with \ respect to time must be zero. Since the derivative is with respect to \ spacetime, the effect of gravity could also be on the distribution of mass in \ space. Excluding point sources, it is clear that the density of mass does \ vary with respect to distance.\ \>", "Text"], Cell["\<\ If there is a new effect of the gravitational force with respect to \ distance, the vector must point along the velocity vector, not Rhat.\ \>", \ "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\({0, \(G\ m\ M R\&~\)\/R\^2} \[Equal] {0, \(-D[m[t] D[R[t], t], t]\)} /. R\&~ -> R\&~ + V\&~\) /. \(m'\)[t] \[Rule] c\ \(m'\)[R]\)], "Input", CellLabel->"In[141]:="], Cell[BoxData[ RowBox[{\({0, \(G\ m\ M\ \((\(R\&~\) + \(V\&~\))\)\)\/R\^2}\), "\[Equal]", RowBox[{"{", RowBox[{"0", ",", RowBox[{ RowBox[{\(-c\), " ", RowBox[{ SuperscriptBox["m", "\[Prime]", MultilineFunction->None], "[", "R", "]"}], " ", RowBox[{ SuperscriptBox["R", "\[Prime]", MultilineFunction->None], "[", "t", "]"}]}], "-", RowBox[{\(m[t]\), " ", RowBox[{ SuperscriptBox["R", "\[Prime]\[Prime]", MultilineFunction->None], "[", "t", "]"}]}]}]}], "}"}]}]], "Output", CellLabel->"Out[141]="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(DSolve[\(G\ M\ m[R]\)\/\(c\ V\ R\^2\) \[Equal] \(-D[m[R], R]\), m[R], R]\)], "Input", CellLabel->"In[142]:="], Cell[BoxData[ \({{m[ R] \[Rule] \[ExponentialE]\^\(\(G\ M\)\/\(c\ R\ V\)\)\ C[ 1]}}\)], "Output", CellLabel->"Out[142]="] }, Open ]], Cell[TextData[{ "The c in the new term is important because it says the new effect will be \ small (most of any effect would be accounted for by c). This small effect \ will have a 1/R dependence, not ", Cell[BoxData[ \(TraditionalForm\`1/R\^2\)]], ". This is precisely the kind of form of an equation that the Modification \ of Newtonian Dynamics (MOND): a small factor that eventually makes a big \ contribution because of the 1/R dependence." }], "Text"], Cell["\<\ So far, I have been unable to apply this new solution to a problem \ in astronomy. The math is a bit tricky, and my skills are limited. It is \ absurdly rare to find a new class of solutions involving gravity, but it must \ be applied to a known situation before the approach has any possibility of \ being accepted.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["VI: The Stress-Energy Tensor", "Subsection"], Cell["\<\ The stress-energy tensor is a second rank symmetric tensor. Here is \ formula to calculate it:\ \>", "Text"], Cell[BoxData[ \(T\^\[Mu]\[Nu] = \(\[PartialD]\[ScriptCapitalL]\/\[PartialD]\(\[Del]\_\ \[Mu] A\_\[Sigma]\)\) \[Del]\^\[Nu] A\_\[Sigma] - \(\(g\^\[Mu]\[Nu]\) \(\ \[ScriptCapitalL]\)\(\ \)\)\)], "Text"], Cell["Calculate the derivative of the Lagrangian:", "Text"], Cell[BoxData[ \(\(\[PartialD]\[ScriptCapitalL]\/\[PartialD]\(\[Del]\_\[Mu] \ A\_\[Sigma]\)\) \[Del]\^\[Nu] A\_\[Sigma] = \[Del]\^\[Mu] A\^\[Sigma] \ \[Del]\^\[Nu] A\_\[Sigma]\)], "Text", CellLabel->"In[110]:="], Cell["\<\ The two tensors that contract are easy enough to calculate \ separately:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[contraD[A]]\)], "Input", CellLabel->"In[340]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\)\), \(\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\)\), \(\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\)\), \(\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\), \(\(-c\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[340]//MatrixForm="] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[contraD[covariant[A]]]\)], "Input", CellLabel->"In[341]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\)\), \(-\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\))\)\), \(-\((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\))\)\), \(-\((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\)}, {\(\(-c\)\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\), \(c\ \((\(\ \ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\)} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output", CellLabel->"Out[341]//MatrixForm="] }, Open ]], Cell["Make a function to do the right kind of contraction.", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"guv", "=", RowBox[{"(", GridBox[{ {"1", "0", "0", "0"}, {"0", "1", "0", "0"}, {"0", "0", "1", "0"}, {"0", "0", "0", "1"} }], ")"}]}], ";"}]], "Input", CellLabel->"In[146]:="], Cell[BoxData[ RowBox[{ RowBox[{"MinkowskiMetric", "=", RowBox[{"(", GridBox[{ {"1", "0", "0", "0"}, {"0", \(-1\), "0", "0"}, {"0", "0", \(-1\), "0"}, {"0", "0", "0", \(-1\)} }], ")"}]}], ";"}]], "Input", CellLabel->"In[147]:="], Cell[CellGroupData[{ Cell[BoxData[ \(contractMM[contraD[A], coD[A]]\)], "Input", CellLabel->"In[350]:="], Cell[BoxData[ \(\(-c\^2\)\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\^2 \ - c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\^2 \ - c\^2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\^2 \ - c\^2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\^2 - c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\^2 \ + \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\))\)\^2 + \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\))\)\^2 + \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]t\))\)\^2 + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, \ y, z]\/\[PartialD]t\))\)\^2\)], "Output", CellLabel->"Out[350]="] }, Open ]], Cell[BoxData[ \(contractMM2M[m1_, m2_] := Module[{u}, Table[{m1[\([u, 1]\)] m2[\([1, 1]\)] - m1[\([u, 2]\)] m2[\([1, 2]\)] - m1[\([u, 3]\)] m2[\([1, 3]\)] - m1[\([u, 4]\)] m2[\([1, 4]\)], \(-m1[\([u, 1]\)]\) m2[\([2, 1]\)] + m1[\([u, 2]\)] m2[\([2, 2]\)] + m1[\([u, 3]\)] m2[\([2, 3]\)] + m1[\([u, 4]\)] m2[\([2, 4]\)], \(-m1[\([u, 1]\)]\) m2[\([3, 1]\)] + m1[\([u, 2]\)] m2[\([3, 2]\)] + m1[\([u, 3]\)] m2[\([3, 3]\)] + m1[\([u, 4]\)] m2[\([3, 4]\)], \(-m1[\([u, 1]\)]\) m2[\([4, 1]\)] + m1[\([u, 2]\)] m2[\([4, 2]\)] + m1[\([u, 3]\)] m2[\([4, 3]\)] + m1[\([u, 4]\)] m2[\([4, 4]\)]}, {u, 4}]]\)], "Input", CellLabel->"In[346]:="], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[ Simplify[Expand[\(-\(1\/\(2 c\^2\)\)\) contractMM2M[contraD[A], contraD[covariantvec[A]]]\ + \(1\/\(2 c\^2\)\) guv\ contractMM[contraD[A], coD[A]]]]]\)], "Input", CellLabel->"In[363]:="], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {\(1\/2\ \((\(-\((\(\ \)\(\[PartialD]\ Ax[t, x, y, \ z]\/\[PartialD]z\))\)\^2\) - \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\ \[PartialD]z\))\)\^2 - \((\(\ \)\(\[PartialD]\ Az[t, x, y, \ z]\/\[PartialD]z\))\)\^2 - \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]z\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ax[t, x, y, \ z]\/\[PartialD]y\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ay[t, x, y, \ z]\/\[PartialD]y\))\)\^2 - \((\(\ \)\(\[PartialD]\ Az[t, x, y, \ z]\/\[PartialD]y\))\)\^2 - \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]y\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ax[t, x, y, \ z]\/\[PartialD]x\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ay[t, x, y, \ z]\/\[PartialD]x\))\)\^2 - \((\(\ \)\(\[PartialD]\ Az[t, x, y, \ z]\/\[PartialD]x\))\)\^2 - \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]x\))\)\^2)\)\), \(-\(\(\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\)\/\(2\ c\)\)\), \ \(-\(\(\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\)\/\(2\ c\)\)\), \ \(-\(\(\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\ \[PartialD]\ Ax[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\ \[PartialD]\ Ay[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\ \[PartialD]\ Az[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\ \[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\)\/\(2\ c\)\)\)}, {\(\(\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\[PartialD]\ \ Ay[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]x\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\)\/\(2\ c\)\), \(-\(\(c\ \^2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\ \[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\ \[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\ \[PartialD]y\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\ \[PartialD]y\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\ \[PartialD]y\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]y\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ax[t, x, y, \ z]\/\[PartialD]t\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ay[t, x, y, \ z]\/\[PartialD]t\))\)\^2 - \((\(\ \)\(\[PartialD]\ Az[t, x, y, \ z]\/\[PartialD]t\))\)\^2 - \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]t\))\)\^2\)\/\(2\ c\^2\)\)\), \(1\/2\ \((\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Ay[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]x\))\))\)\), \(1\/2\ \((\((\(\ \ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]x\))\))\)\)}, {\(\(\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Ay[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\)\/\(2\ c\)\), \(1\/2\ \ \((\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Ay[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]x\))\) + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]y\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]x\))\))\)\), \(-\(\(c\^2\ \ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\ \[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\ \[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]z\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\ \[PartialD]x\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\ \[PartialD]x\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\ \[PartialD]x\))\)\^2 + c\^2\ \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]x\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ax[t, x, y, \ z]\/\[PartialD]t\))\)\^2 - \((\(\ \)\(\[PartialD]\ Ay[t, x, y, \ z]\/\[PartialD]t\))\)\^2 - \((\(\ \)\(\[PartialD]\ Az[t, x, y, \ z]\/\[PartialD]t\))\)\^2 - \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\ \[PartialD]t\))\)\^2\)\/\(2\ c\^2\)\)\), \(1\/2\ \((\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]y\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ Ay[t, x, y, z]\/\[PartialD]y\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]y\))\) + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]y\))\))\)\)}, {\(\(\((\(\ \)\(\[PartialD]\ Ax[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ Ax[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Ay[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ Ay[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ Az[t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ Az[t, x, y, z]\/\[PartialD]t\))\) + \((\(\ \)\(\[PartialD]\ \[Phi][t, x, y, z]\/\[PartialD]z\))\)\ \((\(\ \)\(\[PartialD]\ \ \[Phi][t, x, y, z]\/\[PartialD]t\))\)\