Appendix E. Mathematica code for Figure 1 and Figure 2
ClearAll@"`*"
(*Acceleration Terms*)
at1=FullSimplify[k/r^2];
at2=FullSimplify[(2 k^2)/(r^3 c^2)] ;
at3=FullSimplify[(\[Alpha] H \[DoubleStruckCapitalW] c^2)];
at4=FullSimplify[(4 \[Alpha] H \[DoubleStruckCapitalW] k)/r];
at5=FullSimplify[(\[Alpha] H \[DoubleStruckCapitalW] ((2 k)/(r c))^2)] 10^pno;
at6=FullSimplify[-3 \[Alpha] \[Beta] H^2 r -3 \[Alpha] H vr];
at7=FullSimplify[-((3 k ( \[Beta] H r + vr)^2)/((1+(2 k)/(r c^2)) (r^2 c^2)))];
at8a=0*FullSimplify[(k va^2)/ (r^2 c^2)]; (*<<Note 0* *)
at8b= 0*FullSimplify[va^2/r]; (*<<Note 0* *)
Tot=FullSimplify[at1+at2+at3+at4+at5+at6+at7+at8a+at8b];
(* Physical constants *)
c=3*10^8;
CoulmbC=8.987*10^9;
elmchrg=1.602*10^-19;
NewtonC=6.674*10^-11;
ProtonM=1.672*10^-27;
ElectnM=9.109*10^-31;
k=CoulmbC*elmchrg^2 *qs*qt *(ms/ProtonM)*(1/mt);
va= va0 ;
vr=vr0 Cos[th];
\[DoubleStruckCapitalW]= ( \[Beta] H r +vr)/(( \[Beta] H r +vr)^2+va^2 (1+(2 k)/(r c^2)));
(* Plotting of Acceleration terms *)
SetOptions[Manipulator,Appearance->"Close"];
Manipulate[
PRM= {vr0->v1, va0->v2, H->2.2 *10^HP, th->phase, mt->Mt, ms->Ms, pno->no, qt->Qt, qs->Qs,
\[Alpha]->BB1, \[Beta]->BB2};
STYL1={Thickness->0.004,Dashing[0.004]};
STYL2={Thickness->0.003};
LogLogPlot[{Abs[- k /r^2]/.PRM, Abs[-NewtonC ms * 10^pno /r^2]/.PRM,
+at1/.PRM,-at1/.PRM,+at2/.PRM,-at2/.PRM,+at3/.PRM,-at3/.PRM,+at4/.PRM,-at4/.PRM,+at5/.PRM,-at5/.PRM,
+at6/.PRM,-at6/.PRM,+at7/.PRM,-at7/.PRM,+at8a/.PRM,-at8a/.PRM,+at8b/.PRM,-at8b/.PRM,+Tot/.PRM,-Tot/.PRM},
{r,10^LP,10^UP}, PlotRange->{10^s1, 10^s2},
FrameLabel->{Text[Style["Radial distance [m]",22,FontFamily->"Times"]],
Text[Style["Acceleration [m/s^2]",22,FontFamily->"Times"]]},
Frame->True,FrameStyle->Directive[Black,21],LabelStyle->Directive[Black,22],
PerformanceGoal->"Quality",GridLines->Automatic, Ticks->{Automatic,Automatic},
AxesStyle->Directive[Black,22], ImageSize->800,
PlotStyle->{{DotDashed, Opacity[pr1]},{STYL2,DotDashed,Black, Opacity[pr2]},
{STYL1, ColorData["Crayola"]["NavyBlue"],Opacity[p1]},{STYL2,ColorData["Crayola"]["NavyBlue"],Opacity[p2]},
{STYL1, ColorData["Crayola"]["Blue"],Opacity[p3]},{STYL2,ColorData["Crayola"]["Blue"],Opacity[p4]},
{STYL1, ColorData["Crayola"]["OrangeRed"],Opacity[p5]},{STYL2,ColorData["Crayola"]["OrangeRed"],Opacity[p6]},
{STYL1,ColorData["Crayola"]["HotMagenta"],Opacity[p7]},{STYL2,ColorData["Crayola"]["HotMagenta"],Opacity[p8]},
{STYL1,ColorData["Crayola"]["RadicalRed"],Opacity[p9]},{STYL2,ColorData["Crayola"]["RadicalRed"],Opacity[p10]},
{STYL1,ColorData["Crayola"]["PurpleHeart"],Opacity[p11]},{STYL2,ColorData["Crayola"]["PurpleHeart"],Opacity[p12]},
{STYL1,ColorData["Crayola"]["Shadow"],Opacity[p13]},{STYL2,ColorData["Crayola"]["Shadow"],Opacity[p14]},
{STYL1,ColorData["Crayola"]["JungleGreen"],Opacity[p15]},{STYL2,ColorData["Crayola"]["JungleGreen"],Opacity[p16]},
{STYL1,ColorData["Crayola"]["RobinsEggBlue"],Opacity[p17]},{STYL2,ColorData["Crayola"]["RobinsEggBlue"],Opacity[p18]},
{Thickness->0.005,Blue, Opacity[pt1]}, {Thickness->0.005,Red,Opacity[pt2]}}],
Row[{Style[ "\[FilledSmallCircle] Reference : ", Bold],Spacer[5],Control[{{pr1,0,"E-Field"},{1,0}}],Spacer[5],
Control[{{pr2,1,"G-Field"},{1,0}}],Spacer[15],Style[ "\[FilledSmallCircle] Total : ", Bold],Spacer[5],
Control[{{pt1,1,"+a"},{1,0}}],Spacer[5],Control[{{pt2,1,"-a"},{1,0}}]}],
Row[{Control[{{p1,1,"+1"},{1,0}}],Spacer[5],Control[{{p3,1,"+2"},{1,0}}],Spacer[5],
Control[{{p5,1,"+3"},{1,0}}],Spacer[5],Control[{{p7,1,"+4"},{1,0}}],Spacer[5],
Control[{{p9,1,"+5"},{1,0}}],Spacer[5],Control[{{p11,1,"+6"},{1,0}}],Spacer[5],
Control[{{p13,1,"+7"},{1,0}}],Spacer[5],Control[{{p15,1,"+8a"},{1,0}}],Spacer[5],
Control[{{p17,1,"+8b"},{1,0}}]}],
Row[{Control[{{p2,1,"-1"},{1,0}}],Spacer[5],Control[{{p4,1,"-2"},{1,0}}],Spacer[5],
Control[{{p6,1,"-3"},{1,0}}],Spacer[5],Control[{{p8,1,"-4"},{1,0}}],Spacer[5],
Control[{{p10,1,"-5"},{1,0}}],Spacer[5],Control[{{p12,1,"-6"},{1,0}}],Spacer[5],
Control[{{p14,1,"-7"},{1,0}}],Spacer[5],Control[{{p16,1,"-8a"},{1,0}}],Spacer[5],
Control[{{p18,1,"-8b"},{1,0}}]}],
(* Preset *)
Grid[{{Style["Preset",Bold],PopupMenu[Dynamic[bookMark,{bookMark=#;Which[
bookMark=="Prtn-Elctn",{pr1=0,pr2=1,pt1=1,pt2=1,Qs=-1,Qt=+1,s1=-16,s2=41,LP=-24,UP=30,v1=c/1000,v2=0, no=0, BB1=-0.1},
bookMark=="Prtn-Postn",{pr1=0,pr2=1,pt1=1,pt2=1,Qs=-1,Qt=-1,s1=-16,s2=41,LP=-24,UP=30,v1=c/1000,v2=0, no=0, BB1=-0.1},
bookMark=="SubStructure",{pr1=0,pr2=1,pt1=1,pt2=1,Qs=-1,Qt=+1,s1=24,s2=35,LP=-15,UP=-14,v1=c/1000,v2=0, no=0, BB1=-0.1},
bookMark=="EnlargedRest",{pr1=0,pr2=1,pt1=1,pt2=1,Qs=-1,Qt=+1,s1=24,s2=37,LP=-17,UP=-12,v1=0,v2=0, no=0, BB1=-1},
bookMark=="at Rest",{pr1=0,pr2=1,pt1=1,pt2=1,Qs=-1,Qt=+1,s1=-16,s2=50,LP=-24,UP=30,v1=0,v2=0, no=0, BB1=-1},
bookMark=="Galaxy ",{pr1=0,pr2=1,pt1=0,pt2=0,Qs=-1,Qt=+1,s1=-16,s2=9,LP=0,UP=30,v1=117000,v2=370000, no=69, BB1=-0.1}]}&],
{"Prtn-Elctn","Prtn-Postn","SubStructure","at Rest","EnlargedRest","Galaxy ", "Small r"},
Appearance->"PopupMenu"]}},Spacings->{.5,1},Frame->True,
FrameStyle->Directive[Thickness[.005],Gray]], Delimiter,{{bookMark,"Prtn-Elctn"},None},
Style[" \[FilledSmallCircle] Inspection Range of Radial Distance [10^[X] m]", Bold],
{{LP,-24,"Lower Limit "},-70,30, 1, Appearance->"Open"},{{UP,30,"Upper Limit "},-30,50, 1, Appearance->"Open"},Delimiter,
Style[" \[FilledSmallCircle] Inspection Range of Acceleration [10^[X] m/s^2]", Bold],
{{s2,41,"Upper Limit "},-50,150, 1, Appearance->"Open"},{{s1,-16,"Lower Limit "},-50,50, 1, Appearance->"Open"},Delimiter,
{{v1,c/1000 ,"Radial Speed"},0,c, Appearance->"Open"},{{v2,0 ,"Angular Speed"},0,c, Appearance->"Open"},Delimiter,
{{HP,-18,"Hubble Const [2.2*10^[X]]"},-18, 100},{{phase,0,"Phase of Radial Speed"},0, 2Pi ,Pi/8},Delimiter,
{{Qs,-1,"Q Sign of Source Object"},{-1,0, +1}},{{Ms,ProtonM, "Mass of Source Object"} , {ProtonM, ElectnM}},
{{Qt,+1,"Q Sign of Test Particle"},{-1,0, +1}},{{Mt,ElectnM, "Mass of Test particle"} , {ProtonM, ElectnM}},
{{BB1,-0.1, "Alpha"} , -1,1, Appearance->"Open"},{{BB2,1, "Beta"} , -1,1, Appearance->"Open"},
{{no,0,"Source Mass * 10^[x]"},{0,3, 10, 28.5,51, 57, 69}},ControlPlacement->Right]
(* Strength comparison *)
{at2/Abs[at1],at1/Abs[at1],at8/Abs[at1],at5/Abs[at1],-NewtonC ms /r^2 /Abs[at1]}/.
{r->0.5*10^-16, vr0->c/1000, va0->0,th->0, pno->0, qs->-1, qt->1,
H->2.2*10^-18, ms-> ProtonM, mt-> ElectnM, \[Alpha]->-0.1, \[Beta]->1}
Appendix F. Mathematica code for Figure 3
ClearAll@"`*"
at3=FullSimplify[(\[Alpha] H \[DoubleStruckCapitalW] c^2)];
at5=FullSimplify[(\[Alpha] H \[DoubleStruckCapitalW] ((2 k)/(r c))^2)] 10^pno;
at6=FullSimplify[-3 \[Alpha] \[Beta] H^2 r];
(* Physical constants *)
c=3*10^8;
CoulmbC=8.987*10^9;
elmchrg=1.602*10^-19;
NewtonC=6.674*10^-11;
ProtonM=1.672*10^-27;
ElectnM=9.109*10^-31;
k=CoulmbC*elmchrg^2 *qs*qt *(ms/ProtonM)*(1/mt);
va= va0 ;
vr=vr0 Cos[th];
\[DoubleStruckCapitalW]= ( \[Beta] H r +vr)/(( \[Beta] H r +vr)^2+va^2 (1+(2 k)/(r c^2)));
(* Plotting of Acceleration terms *)
SetOptions[Manipulator,Appearance->"Close"];
Manipulate[
PRM1= {vr0->v1, va0->v2, H->2.2 *10^HP, th->phase, mt->Mt, ms->Ms, pno->no, qt->Qt, qs->Qs,
\[Alpha]->-1/100, \[Beta]-> 1};
PRM2= {vr0->v1, va0->v2, H->2.2 *10^HP, th->phase, mt->Mt, ms->Ms, pno->no, qt->Qt, qs->Qs,
\[Alpha]-> -5, \[Beta]-> 1};
PRM3= {vr0->v1, va0->v2, H->2.2 *10^HP, th->phase, mt->Mt, ms->Ms, pno->no, qt->Qt, qs->Qs,
\[Alpha]->- 1/10, \[Beta]-> 1};
PRM4= {vr0->v1 *5, va0->v2, H->2.2 *10^HP, th->phase, mt->Mt, ms->Ms, pno->no, qt->Qt, qs->Qs,
\[Alpha]-> -1/10, \[Beta]-> 1};
PRM= {vr0->v1/1, va0->v2, H->2.2 *10^HP, th->phase, mt->Mt, ms->Ms, pno->no, qt->Qt, qs->Qs,
\[Alpha]-> - 1/100, \[Beta]-> 1};
STYL1={Thickness->0.004,Dashing[0.004]};
STYL2={Thickness->0.003};
STYL2a={Thickness->0.003, ColorData["Crayola"]["NavyBlue"]};
STYL2b={Thickness->0.003, ColorData["Crayola"]["OrangeRed"]};
LogLogPlot[ {Abs[-NewtonC ms * 10^pno /r^2]/.PRM,
-at5/.PRM1,-at5/.PRM2,-at5/.PRM3,-at5/.PRM4,-at5/.PRM,
-at3/.PRM1,-at3/.PRM2,-at3/.PRM3,-at3/.PRM4,-at3/.PRM, at6/.PRM},{r,10^LP,10^UP}, PlotRange->{10^s1, 10^s2},
FrameLabel->{Text[Style["Radial distance [m]",22,FontFamily->"Times"]],
Text[Style["Acceleration [m/s^2]",22,FontFamily->"Times"]]},
Frame->True,FrameStyle->Directive[Black,21], GridLines->None,ImageSize->800,
Filling->{2->{{3},{LightBlue}}, 4-> {5}, 7-> {8}, 9-> {10}},
PlotStyle->{{STYL2,DotDashed,Black, Opacity[G]},
{STYL2a,Opacity[p1]},{STYL2a,Opacity[p2]},
{STYL2b, Opacity[p3]},{STYL2b,Opacity[p4]},{STYL2, Black,Opacity[p5]},
{STYL2a, Opacity[p11]},{STYL2a,Opacity[p12]},
{STYL2b, Opacity[p13]},{STYL2b,Opacity[p14]},{STYL2, Black,Opacity[p15]},
{STYL1, Black,Opacity[p6]}}],
Row[{Style[ "\[FilledSmallCircle] Reference : ", Bold],Spacer[5],Control[{{G,1,"G-Field"},{1,0}}],
Spacer[15], Control[{{p6,1,"6"},{1,0}}]}],Delimiter,
Row[{Style[ "\[FilledSmallCircle] 5th terms : ", Bold],Spacer[5],Control[{{p1,1,"1"},{1,0}}],Spacer[5],
Control[{{p2,1,"2"},{1,0}}],Spacer[5],
Control[{{p3,1,"3"},{1,0}}],Spacer[5],Control[{{p4,1,"4"},{1,0}}],Spacer[5],Control[{{p5,0,"5"},{1,0}}]}],
Delimiter, Row[{Style[ "\[FilledSmallCircle] 3rd terms : ", Bold],Spacer[5],Control[{{p11,1,"1"},{1,0}}],
Spacer[5], Control[{{p12,1,"2"},{1,0}}],Spacer[5],
Control[{{p13,1,"3"},{1,0}}],Spacer[5],Control[{{p14,1,"4"},{1,0}}],Spacer[5],Control[{{p15,0,"5"},{1,0}}]}],
{{LP,17,"Lower Limit "},-70,30, 1(*, Appearance\[Rule]"Open"*)},
{{UP,28,"Upper Limit "},-30,50, 1(*, Appearance\[Rule]"Open"*)},Delimiter,
{{s2,-5,"Upper Limit "},-50,150, 1(*, Appearance\[Rule]"Open"*)},
{{s1,-11,"Lower Limit "},-50,50, 1(*, Appearance\[Rule]"Open"*)},Delimiter,
{{v1,10000 ,"Radial Speed"},0,c, Appearance->"Open"},
{{v2,400000 ,"Angular Speed"},0,c},Delimiter,
{{HP,-18,"Hubble Const [2.2*10^[X]]"},-18, 100},
{{phase,0,"Phase of Radial Speed"},0, 2Pi ,Pi/8},Delimiter,
{{Qs,-1,"Q Sign of Source Object"},{-1,0, +1}},
{{Ms,ProtonM, "Mass of Source Object"} , {ProtonM, ElectnM}},
{{Qt,+1,"Q Sign of Test Particle"},{-1,0, +1}},
{{Mt,ElectnM, "Mass of Test particle"} , {ProtonM, ElectnM}},
{{no,69,"Source Mass * 10^[x]"},{0,3, 10, 28.5,51, 57, 69}},ControlPlacement->Right]