Why Does Light Move?

Initialize the Program

ClearAll["Global`*"];
SetDirectory[NotebookDirectory[]];

Constants of Nature

ElementaryCharge=1.60217662 10^-19;
SpeedOfLight= 299792458;
PlanckConstant=6.62607004 10^-34;
GravitationalConstant=6.6740810^-11;
ElementaryCharge=1.60217662 10^-19;
ElectricConstant=8.85418782 10^-12;
MagneticPermeability=4 Pi 10^-7;

Wavelength of Binary Photon

greenWavelength=500 10^-9;
λ=greenWavelength;
ν=SpeedOfLight/λ;
period=1/ν;
ω= 2π ν;

Wave Functions of the Binary Photon

leadingSemiphotonPosition[w_]:={
 (λ/(2 Pi))*Cos[2 Pi w],
- (λ/(2 Pi))*Sin[2 Pi* w],
(λ w) +(2λ/(2Pi)^2 )* (Cos[2Pi w]^2)};

followingSemiphotonPosition[w_]:={
(λ/(2 Pi))*Cos[2 Pi w],
(λ/(2 Pi))*Sin[2 Pi* w],
(λ w) +(-2λ/(2 Pi)^2) * (Cos[ 2 Pi w]^2)};

λ=500 10^-9;

Plot[{{(λ/(2 Pi))*Cos[2 Pi w],(λ/(2 Pi))*Sin[2 Pi* w],(2λ/(2Pi)^2 )*Cos[1 Pi w]^2}}, {w,0,1}]
Plot[{{(λ/(2 Pi))*Cos[2 Pi w],(-λ/(2 Pi))*Sin[2 Pi* w],(2λ/(2Pi)^2 )*Cos[1 Pi w]^2}}, {w,0,1}]

Produce Figures from Calculated Forces, Accelerations, Velocities, and other Values

vl[w_]=(SpeedOfLight/ λ)*D[leadingSemiphotonPosition[w][[3]],w];
vf[w_]=
(SpeedOfLight/ λ)* D[followingSemiphotonPosition[w][[3]],w];
al[t_]=(SpeedOfLight/ λ)*D[(SpeedOfLight/ λ)*D[leadingSemiphotonPosition[w][[3]],w],w];
af[t_]=(SpeedOfLight/ λ)*D[(SpeedOfLight/ λ)*D[followingSemiphotonPosition[w][[3]],w],w];

Figure 2

λ=greenWavelength;r[w_]:= Norm[leadingSemiphotonPosition[w]-followingSemiphotonPosition[w]];
rl[w_]:= Norm[leadingSemiphotonPosition[w]-followingSemiphotonPosition[w]];
rf[w_]:= Norm[followingSemiphotonPosition[w]-leadingSemiphotonPosition[w]];
ml = PlanckConstant/(SpeedOfLight *λ);
mf=-ml;
gForceLeading[w_]:=(-GravitationalConstant ml mf (leadingSemiphotonPosition[w]-followingSemiphotonPosition[w])/(rl[w])^3);
gForceFollowing[w_]:=(-GravitationalConstant  ml mf (followingSemiphotonPosition[w]-leadingSemiphotonPosition[w])/(rf[w])^3);
gforce=Plot[{gForceLeading[w][[3]],gForceFollowing[w][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Repulsive Gravitational Force, N"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue},{ Red}},PlotRange->Full]


Export["TJP2.jpg",gforce]

Figure 3

gAccLeading[w_]:=-(GravitationalConstant mf (leadingSemiphotonPosition[w]-followingSemiphotonPosition[w])/(rl[w])^3)
gAccFollowing[w_]:=-(GravitationalConstant   ml (followingSemiphotonPosition[w]-leadingSemiphotonPosition[w])/(rf[w])^3);
gAcc=Plot[{gAccLeading[w+.25][[3]], gAccFollowing[w+.25][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Gravitational Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue,Dotted},{ Red,Dashed}},PlotRange->Full]

Export["TJP3.jpg",gAcc]
FindMaximum[gAccLeading[w][[3]],{w,0,1}]
a =SpeedOfLight/(1.4716976358708873`*^-30)
min=(a/60)
hour= min/60
day=hour/24
year=day/365

Figure 5

coulombfLeading[w_]:=-(-1.6 10^-19 1.6 10^-19  (leadingSemiphotonPosition[w]-followingSemiphotonPosition[w])/( 4 Pi 8.85 10^-12 (rl[w])^3));
coulombfFollowing[w_]:=-(-1.6 10^-19 1.6 10^-19  (followingSemiphotonPosition[w]-leadingSemiphotonPosition[w])/( 4 Pi 8.85 10^-12 (rf[w])^3));
coulombf=Plot[{coulombfLeading[w][[3]],coulombfFollowing[w][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Repulsive Coulombic Force, N"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]

Export["phaseFigure5.jpg",coulombf]

coulombaccLeading[w_]:=-(-1.6 10^-19 1.6 10^-19 (leadingSemiphotonPosition[w]-followingSemiphotonPosition[w])/( ml 4 Pi 8.85 10^-12 (rl[w])^3));
coulombaccFollowing[w_]:=-(-1.6 10^-19 1.6 10^-19 (followingSemiphotonPosition[w]-leadingSemiphotonPosition[w])/(mf 4 Pi 8.85 10^-12 (rf[w])^3));
coulombacc=Plot[{coulombaccLeading[w+.25][[3]],coulombaccFollowing[w+.25][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Coulombic Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue,Dotted}, {Red,Dashed}},PlotRange->Full]
Export["phaseFigure6.jpg",coulombacc]
FindMaximum[coulombaccLeading[w][[3]],{w,0,1}]

ab=SpeedOfLight/(2.0289950977537006`*^22)

relvel=Plot[{(((vl[w]/{0,0,SpeedOfLight}[[3]]))),(((vf[w]/{0,0,SpeedOfLight }[[3]])))},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Relative Velocity"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]
Export["phaseFigure7.jpg",relvel]

emfLeading[w_]:=-(-1.6 10^-19 1.6 10^-19 ) (leadingSemiphotonPosition[w][[3]]-followingSemiphotonPosition[w])[[3]](vl[w]-{0,0,SpeedOfLight})[[3]]/( {0,0,SpeedOfLight}[[3]]4 Pi  8.85 10^-12 (rl[w])^3);
emfFollowing[w_]:=-(-1.6 10^-19 1.6 10^-19 ) (followingSemiphotonPosition[w][[3]]-leadingSemiphotonPosition[w])[[3]](vf[w]-{0,0,SpeedOfLight})[[3]]/( {0,0,SpeedOfLight}[[3]]4 Pi  8.85 10^-12 (rf[w])^3);
emf=Plot[{emfLeading[w],emfFollowing[w]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Electromagnetic Force, N"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue,Dotted}, {Red,Dashed}},PlotRange->Full]

Export["phaseFigure8.jpg",emf]

emAccLeading[w_]:=-(-1.6 10^-19 1.6 10^-19 ) (leadingSemiphotonPosition[w][[3]]-followingSemiphotonPosition[w])[[3]](vl[w]-{0,0,SpeedOfLight})[[3]]/( ml{0,0,SpeedOfLight}[[3]]4 Pi  8.85 10^-12 (rl[w])^3);
emAccFollowing[w_]:=-(-1.6 10^-19 1.6 10^-19 ) (followingSemiphotonPosition[w][[3]]-leadingSemiphotonPosition[w])[[3]](vf[w]-{0,0,SpeedOfLight})[[3]]/( mf{0,0,SpeedOfLight}[[3]]4 Pi  8.85 10^-12 (rf[w])^3);
emAcc=Plot[{emAccLeading[w+.25],emAccFollowing[w+.25]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Electromagnetic Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]
Export["phaseFigure9.jpg",emAcc]

diff=Plot[{coulombaccLeading[w+.25][[3]],coulombaccFollowing[w+.25][[3]],emAccLeading[w+.25],emAccFollowing[w+.25]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue,Dotted}, {Red,Dashed}, {Blue}, {Red}},PlotRange->Full]
Export["phaseFigure10.jpg",diff]

TotalForceLeading[w_]:=gForceLeading[w]+coulombfLeading[w]+emfLeading[w]
TotalForceFollowing[w_]:=gForceFollowing[w]+coulombfFollowing[w]+emfFollowing[w]
totalf=Plot[{TotalForceLeading[w][[3]],TotalForceFollowing[w][[3]]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Total Force, N"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]

Export["phaseFigure11.jpg",totalf]

TotalAccLeading[w_]:=gAccLeading[w]+coulombaccLeading[w]+emAccLeading[w]
TotalAccFollowing[w_]:=gAccFollowing[w]+coulombaccFollowing[w]+emAccFollowing[w]
totalacc=Plot[{TotalAccLeading[w+.25][[3]],TotalAccFollowing[w+.25][[3]]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Total Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]

Export["totalacc.jpg",totalacc]
Export["phaseFigure12.jpg",totalacc]

diffForce=Plot[{TotalForceLeading[w][[3]]-TotalForceFollowing[w][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Differential Force, N"},LabelStyle->Directive[Black,Bold],PlotStyle->{Black},PlotRange->Full]
diffacc=Plot[{TotalAccLeading[w+.25][[3]]-TotalAccFollowing[w+.25][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Differential Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{Black},PlotRange->Full]
diffForce=Plot[{TotalForceLeading[w][[3]]-TotalForceFollowing[w][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Differential Force, N"},LabelStyle->Directive[Black,Bold],PlotStyle->{Black},PlotRange->Full]


diffacc=Plot[{TotalAccLeading[w+.25][[3]]-TotalAccFollowing[w+.25][[3]]},{w,0, 1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Differential Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{Black, Dashed},PlotRange->Full]

totalboth=Plot[{{diffForce[w][[3]],PlotStyle->{Black, Thick}},{diffacc[w+.25][[3]],PlotStyle->{Black, Dashed}}}, {w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, 
Export["phaseFigure13.jpg",diffacc]]
Export["diffForce.jpg",diffForce]
Export["diffacc.jpg",diffacc]

reynolds=Plot[{(gForceLeading[w]+(coulombfLeading[w])/(emfLeading[w]))[[3]],(gForceFollowing[w]+(coulombfFollowing[w])/(emfFollowing[w]))[[3]]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Reynolds Number"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}}]
Export["reynolds.jpg",reynolds]
Export["phaseFigure14.jpg",reynolds]

distance1=Plot[{leadingSemiphotonPosition[w][[3]],followingSemiphotonPosition[w][[3]]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Position, m"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]

Export["Figure15.jpg",distance1]


cvelocity=Plot[{vl[w],vf[w]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Velocity, m/s"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]

Export["Figure16.jpg",cvelocity]


cacceleration=Plot[{al[w],af[w]},{w,0,1},AxesStyle->Directive[Black,Bold,12],Frame->True, FrameLabel->{"Phase of Binary Photon","Acceleration, m (s^(-2))"},LabelStyle->Directive[Black,Bold],PlotStyle->{{Blue}, {Red}},PlotRange->Full]

Export["Figure17.jpg",cacceleration]

NMaximize[TotalForceLeading[w][[3]],w] 
NMinimize[TotalForceFollowing[w][[3]],w]
2 NMaximize[TotalForceLeading[w][[3]],w]

Plot[{coulombfLeading[w][[3]],emfLeading[w]}, {w,0,1}]

(*Integrate[TotalForceLeading[w][[3]],w]*)

(*Simplify[%288]*)

(*a[t_]:=TotalForceLeading[t][[3]];
v[t_]:=Integrate[a[w],{w,0,t}]
Plot[v[t],{t,0,1},PlotRange->Full]*)

gal[w_]:=gForceLeading[w][[3]]/ml;
Plot[gal[w],{w,0,1}]
gvl[t_]:=NIntegrate[gal[w],{w,0,t}]
cal[w_]:=coulombfLeading[w][[3]]/ml;
Plot[cal[w],{w,0,1}]
cvl[t_]:=NIntegrate[cal[w],{w,0,t}]
emal[w_]:=emfLeading[w]/ml;
(*Plot[emal[w],{w,0,1}]
emvl[t_]:=NIntegrate[emal[w],{w,0,t}]
Plot[gvl[t]+cvl[t]+emvl[t],{t,0,1}]*)
Plot[gvl[t]+cvl[t],{t,.1,.2}]

(*Plot[vl[t],{t,0,.01},PlotRange->Full]*)
(*af[w_]:=TotalForceFollowing[w][[3]]/mf;
vf[t_]:=NIntegrate[af[w],{w,0,t}]
Plot[vf[t],{t,0,.01},PlotRange->Full]*)

Plot[TotalForceLeading[w][[3]]+TotalForceFollowing[w][[3]],{w,0,1}]

vvvv= 4(λ /SpeedOfLight)NMaximize[TotalAccLeading[t][[3]],t]
NMaximize[TotalAccFollowing[t][[3]],t]

Plot[Norm[leadingSemiphotonPosition[w]-followingSemiphotonPosition[w]]^2, {w,0,1}]
Plot[Norm[leadingSemiphotonPosition[w][[1]]-followingSemiphotonPosition[w][[1]]]^2, {w,0,1}]
Plot[Norm[leadingSemiphotonPosition[w][[2]]-followingSemiphotonPosition[w][[2]]]^2, {w,0,1}]
Plot[Norm[leadingSemiphotonPosition[w][[3]]-followingSemiphotonPosition[w][[3]]]^2, {w,0,1}]

ν=SpeedOfLight/λ
force= ν ν PlanckConstant/(2 Pi SpeedOfLight)