[CAS-Lab] 特殊相対性理論 虚数角回転によるローレンツ変換（Mathematica編）

物理学ノート

はじめに

本稿は下記『特殊相対性理論　[付録稿] 虚数角回転によるローレンツ変換』で使用したMathematicaのソースコード（個人での利用を許可します）の公開と簡単な解説です。Mathematicaの環境が無い場合はこちらを参考に環境を整備してください。

特殊相対性理論　[付録稿] 虚数角回転によるローレンツ変換
擬ユークリッド空間でのローレンツ変換は、ユークリッド空間での回転変換によく似ているといわれている。なんと回転の変換式に、虚数の回転角を入れるだけでローレンツ変換と等価となるとのこと。 なかなか興味深い話である。
academians.net

サンプルプログラム実行前の準備

1) サンプルプログラム使用パッケージ（描画関数や座標変換関数等）のセーブ

以下ボタンで［.nb］ファイルをダウンロードしMathematicaで開いて実行してみてください。実行後いくつかのパッケージ（xxx.pac) がWindowsの場合デフォルトで”ドキュメント”　ディレクトリにセーブされるはずです。

(*Mathematica*)

(*---------------基本パッケージ-----------------*)
　　：
　関数、変数定義　省略
　　：
(*---------------変換パッケージ-----------------*)
　　：
　関数、変数定義　省略
　　：
(*---------------描画パッケージ-----------------*)
　　：
　関数、変数定義　省略
　　：
Save[(*cnd*)"udPlotPac1.pac",
 {
 セーブする関数、変数名のリスト  
 }];

上記ではソースコードの転記と解説を省略しました。ダウンロードした実物で内容は確認してください。

サンプルプログラムの実行

以下のボタンでサンプルプログラムをダウンロードしMathematicaで開いて実行できます。あるいは、自身で新規の .nb ファイルを開き、以下に続くサンプルコードをセル単位でコピペしながらステップバイステップで実行してみてください。

最初にグローバル変数等の初期化と上記でセーブしたパッケージ の内、”udPlotPac1.pac” 、 “udElemntPac1.pac” と”udTransform1.pac”を読み込ます。これにより以降のプログラムで使用可能となります。

ClearAll["Global`*"]

Get["udElemntPac1.pac"];
Get["udPlotPac1.pac"];
Get["udTransform1.pac"];

サンプルプログラムの実行

以上で作業準備は終わりました。以降『特殊相対性理論　[付録稿] 虚数角回転によるローレンツ変換』の数式検証とグラフ化に関するプログラムになります。各章節事にリンクを貼ってあるので内容を読み比べながらプログラムを実行してください。

1 三角関数と双曲線関数の関係

TrigToExp[Sin[\[Theta]]]
TrigToExp[Cos[\[Theta]]]

TrigToExp[Sin[I \[Theta]]]
% // FullSimplify
TrigToExp[Cos[I \[Theta]]]
% // FullSimplify

Plot[{Sinh[\[Theta]], Cosh[\[Theta]], Tanh[\[Theta]]}, {\[Theta], -n, n},
 AspectRatio -> 1, PlotStyle -> {Blue, Red, Green}, 
 PlotLegends -> Placed["Expressions", {Right, Bottom}]]

2 回転変換とローレンツ変換の比較

2.1 回転変換

(*基準系を表示*)
B=e;
grXsys=tfCrdSys2Dg[LTF,e,gX,scText,scOfst,cBluH,1];
vW=vec[{cBluH,Thick},t[B],{"\[InvisiblePrefixScriptBase] e1","           e2"},1.lp[45]];
pVfe=pltVf[Red,{" Px1","Px2","Px"},B];
Show[grXsys,vW,PlotRange->{{Gh[[1,1]],Gh[[1,2]]+0.01},{Gh[[2,1]]+0.7,Gh[[2,2]]}}]
Show[grXsys,vW,pVfe,PlotRange->{{Gh[[1,1]],Gh[[1,2]]+0.01},{Gh[[2,1]]+0.7,Gh[[2,2]]}}]

(*基準系にローレンツ基底Bを表示*)
iBlzO={{1/Sqrt[1-\[Beta]^2],-(\[Beta]/Sqrt[1-\[Beta]^2])},
     {-(\[Beta]/Sqrt[1-\[Beta]^2]),1/Sqrt[1-\[Beta]^2]}};
%//MatrixForm
Print["B^-1=iBlzO=",iBlzO//mf]
Print["B=iBlzO^-1=",i[iBlzO]//Simplify//mf]
B=i[iBlzO]/.\[Beta]->0.6
(*B=Abs[rt[I ArcTanh[0.6]]].e;*)
W=B;Print["W=",W//mf];Print["W^-1=",i[W]//mf]

vW=vec[{cGrnH,Thick},t[B],{"b1","  b2"}];
Show[grXsys,vW,pVfe,PlotRange->{{Gh[[1,1]],Gh[[1,2]]+0.01},{Gh[[2,1]]+0.7,Gh[[2,2]]}}]

(*基準系に斜交ベクトルBと斜交座標と変換オブジェクトを表示*)
grXsys=tfCrdSys2Dg[LTF,e,gX,scText,scOfst,cBluL,1];
grUsys=tfCrdSys2Dg[LTF,B,{2{-1,1},2{-1,1}},scText,scOfst,cGrnH,1];
Show[grXsys,vW,grUsys,pVfe]
Show[grXsys,vW,grUsys]

(*回転座標系に移動しベクトルBとと変換オブジェクトを表示*)
vW=vec[{cGrnH,Thick},t[i[B].B],{"B^-1b1","       B^-1b2"},0.7lp[-45]];
grXsys=tfCrdSys2Dg[LTF,i[B],{2{-1,1},2{-1,1}},scText,scOfst,cBluL,1];
grUsys=tfCrdSys2Dg[LTF,i[B].B,{3{-1,1},3{-1,1}},scText,scOfst,cGrnH,1];
Show[grXsys,grUsys,vW,pltVf[Red,{"B^-1Px1","B^-1Px2        ","             B^-1Px"},i[B]]]

2.2 ローレンツ変換

(*基準系を表示*)

B=e;
grXsys=tfCrdSys2Dg[LTF,e,gX,scText,scOfst,cBluH,1];
vW=vec[{cBluH,Thick},t[B],{"\[InvisiblePrefixScriptBase] e1","           e2"},1.lp[45]];
pVfe=pltVf[Red,{" Px1","Px2","Px"},B];
Show[grXsys,vW,PlotRange->{{Gh[[1,1]],Gh[[1,2]]+0.01},{Gh[[2,1]]+0.7,Gh[[2,2]]}}]
Show[grXsys,vW,pVfe,PlotRange->{{Gh[[1,1]],Gh[[1,2]]+0.01},{Gh[[2,1]]+0.7,Gh[[2,2]]}}]

(*基準系にローレンツ基底Bを表示*)
Print["B^-1=iBlzO=",iBlzO//mf]
Print["B=iBlzO^-1=",i[iBlzO]//Simplify//mf]
B=i[iBlzO]/.\[Beta]->0.6
(*B=Abs[rt[I ArcTanh[0.6]]].e;*)
W=B;Print["W=",W//mf];Print["W^-1=",i[W]//mf]

vW=vec[{cGrnH,Thick},t[B],{"b1","  b2"}];
Show[grXsys,vW,pVfe,PlotRange->{{Gh[[1,1]],Gh[[1,2]]+0.01},{Gh[[2,1]]+0.7,Gh[[2,2]]}}]

(*基準系に斜交ベクトルBと斜交座標と変換オブジェクトを表示*)
grXsys=tfCrdSys2Dg[LTF,e,gX,scText,scOfst,cBluL,1];
grUsys=tfCrdSys2Dg[LTF,B,{2{-1,1},2{-1,1}},scText,scOfst,cGrnH,1];
Show[grXsys,vW,grUsys,pVfe]
Show[grXsys,vW,grUsys]

(*回転座標系に移動しベクトルBとと変換オブジェクトを表示*)
vW=vec[{cGrnH,Thick},t[i[B].B],{"B^-1b1","       B^-1b2"},0.7lp[-45]];
grXsys=tfCrdSys2Dg[LTF,i[B],{2{-1,1},2{-1,1}},scText,scOfst,cBluL,1];
grUsys=tfCrdSys2Dg[LTF,i[B].B,{3{-1,1},3{-1,1}},scText,scOfst,cGrnH,1];
Show[grXsys,grUsys,vW,pltVf[Red,{"B^-1Px1","B^-1Px2        ","             B^-1Px"},i[B]]]

3 虚数角回転変換

2行目は虚数時間で実行するか、虚数空間で実行するかのオプション。デフォルトは虚数時間。imTime=Falseとすると、虚数空間での実行となる。

a）imTime=Trueとして虚数時間での実行

以下虚数時間で虚数角回転変換の処理となる。

処理手順１
ClearAll[x, x1, x2, u, u1, u2]
imTime = True;(*imTime or imSpace*)
x = {x1, x2};
If[imTime,
 Print["(*虚数時間　Cx　の設定*)"]; Cx = dm[{1, I}].x;,
 Print["(*虚数空間　Cx　の設定*)"]; Cx = dm[{I, 1}].x;
 ]
Print["Cmplx_x=", Cx // mf];

If[imTime,
 Print["(*虚数時間用の虚数角基底　B_hyp　の設定、変形および、変換*)"];
 Bhyp = rt[I \[Theta]] // Simplify;,
 Print["(*虚数空間用の虚数角基底　B_hyp　の設定、変形および、変換*)"];
 Bhyp = i[rt[I \[Theta]]] // Simplify;
 ]
Print["B_hyp=", Bhyp // mf]
Bt = Bhyp /. {Sinh[\[Theta]] -> Tanh[\[Theta]]/Sqrt[1 - Tanh[\[Theta]]^2],
         Cosh[\[Theta]] -> 1/Sqrt[1 - Tanh[\[Theta]]^2]};
Print["B_tanh=", Bt // mf]

Bb = Bt /. Tanh[\[Theta]] -> \[Beta];
Print["B_beta=", Bb // mf]
Print["変換結果１：　B_beta.Cmplx_x=", Bb.Cx // Simplify // mf]

Print["(*オリジナルローレンツ変換基底　B_olz　の設定、変形および、変換*)"]
Bo = {{1/Sqrt[1 - \[Beta]^2], -(\[Beta]/Sqrt[1 - \[Beta]^2])},
        {-(\[Beta]/Sqrt[1 - \[Beta]^2]), 1/Sqrt[1 - \[Beta]^2]}};
Print["B_olz=", Bo // mf]
u = Bo.{x1, x2};
Print["変換結果２：　B_olz.x=", u // Simplify // mf]

Print["(*\[Beta]=0.6で虚数角回転によるローレンツ変換*)"]
Print["\[Theta] for \[Beta]:0.6 = ", ArcTanh[0.6]]

Cu = rt[I \[Theta]].Cx /. \[Theta] -> ArcTanh[0.6];

Print["Cu=rt[I \[Theta]].Cx の実行結果"]
Print[Cu // Simplify // mf, " = ", rt[I \[Theta]] /. \[Theta] -> ArcTanh[0.6] // mf, Cx // mf]
実行結果１

虚数回転では変換前後で虚数 i が時間x2側に掛かっている、つまり虚数時間時空での変換であることを確認。

4 不変量 s2

処理手順２
Print["(*不変距離 \!\(\*SuperscriptBox[\(s\), \(2\)]\)= Cx.Cx = Cu.Cu の確認*)"]
Print["\!\(\*SuperscriptBox[\(s\), \(2\)]\)=Cx.Cx= ", Cx.Cx // Simplify]
Print["\!\(\*SuperscriptBox[\(s\), \(2\)]\)=Cu.Cu= ", Cu.Cu // Simplify]
Print["(*不変距離 \!\(\*SuperscriptBox[\(s\), \(2\)]\)= x.\[Eta].x = u.\
\[Eta].u の確認*)"]
If[imTime,
 Print["\!\(\*SuperscriptBox[\(s\), \(2\)]\)=x.\[Eta].x= ", x.eta.x // Simplify];
 Print["\!\(\*SuperscriptBox[\(s\), \(2\)]\)=u.\[Eta].u= ", u.eta.u // Simplify];
 Print["\[Eta] =  ", eta // mf];,
 Print["\!\(\*SuperscriptBox[\(s\), \(2\)]\)=x.\[Eta].x= ", x.-eta.x // Simplify];
 Print["\!\(\*SuperscriptBox[\(s\), \(2\)]\)=u.\[Eta].u= ", u.-eta.u // Simplify];
 Print["\[Eta] =  ", -eta // mf];
 ]
実行結果２

不変距離 s2 が虚数時間虚数角回転とローレンツ変換の両者で一致することを確認。ローレンツ変換ではηのマイナス符号は時間側に掛かる。

b）imTime=Falseとして虚数空間での実行

以下の様に2行目を”imTime = Fauls;”と変更して実行。

ClearAll[x, x1, x2, u, u1, u2]
imTime = Fauls; (* imTime or imSpace *)
x = {x1, x2};
　：
　：
実行結果３

変換前と変換結果で Cmplx_x の空間側に i が掛かっていて虚数空間での演算となっている。回転変換の行列B_Hypで回転方向が逆になっていることを確認。

上記で変換結果１と比較し空、間側が虚数になっていること以外全て一致することを確認。

不変距離の符号定義でが空間側がマイナスに変わっていることを確認。

以上

（時間が出来たら、もう少し補足・説明を追加します）

Post Views: 1

コメント

タイトルとURLをコピーしました