I1=(({{1, 0}, {0, 1}})); (* Macierz jednostkowa *)
Q=(({{1, 0}, {0, I}})); (* Macierz Jonesa płytki ćwierćfalowej *)
R[θ_]:=(θ1=θ Pi/180;(({{Cos[θ1], -Sin[θ1]}, {Sin[θ1], Cos[θ1]}}))); (* Zwykły obrót *)
H=(({{1, 0}, {0, -1}})); (* Macierz Jonesa płytki półfalowej *)
Normuj[vec_]:=vec/Norm[vec];

(* Działanie płytek falowych z osią pod kątem *)
QR[x_]:=Chop[R[x].Q.R[-x]];
HR[x_]:=Chop[R[x].H.R[-x]];

(* Efekt wzmocnienia jednej ze składowych kołowych. Uwaga nie zachowuje normy wektora! *)
ZwiekszKolowa[a_]:=(
v1=(1/(Sqrt[2])){{1,I}};
v2=(1/(Sqrt[2])){{1,-I}};
v1\[ConjugateTranspose].v1+a v2\[ConjugateTranspose].v2)

(* Zamiara wektora polaryzacji Jonesa na wektor na sferze Blocha (Stokesa) *)
Jones2Bloch[{ Ex_,Ey_}]:=N[{((Abs[Ex])^2)-Abs[(Ey^2)],2Re[Ex Ey\[Conjugate]],2Im[Ex Ey\[Conjugate]]}/(((Abs[Ex])^2)+((Abs[Ey])^2))]

(* Generuje punkty na sferze do obrotu pomierzy wektorem v1 i v2. Funkcja słuzy mi do rysowania strzałem np. po wzmocnieniu Ramana czy obrocie polaryzacji *) 
GenPunktyObrot[v1_,v2_]:=(
If[Norm[v1-v2]<0.01,{v1,v2},(
rot=RotationTransform[θ,{v1,v2}];
Table[N[rot[v1]],{θ,0,VectorAngle[v1,v2],VectorAngle[v1,v2]/10}])]
)

(* Generuje strzlke do narysowania obrotu wektora v1 za pomoca cwiercfali i półfalówki pod katem θ *)
StrzalkaQW[v1_, θ_]:=
(
wektorobrotu=-{Cos[2θ Pi/180],Sin[2θ Pi/180],0};
rot=RotationTransform[φ,wektorobrotu];
Arrow[Table[N[rot[v1]],{φ,0,Pi/2,0.1}]]
)
StrzalkaHW[v1_, θ_]:=
(
wektorobrotu=-{Cos[2θ Pi/180],Sin[2θ Pi/180],0};
rot=RotationTransform[φ,wektorobrotu];
Arrow[Table[N[rot[v1]],{φ,0,Pi,0.1}]]
)

(* Stałe elementy wykresu *)
equators={ParametricPlot3D [Evaluate[{Cos[t],Sin[t],0}],{t,0,2 π},PlotStyle->{Black,Thin}],ParametricPlot3D [Evaluate[{Cos[t],0,Sin[t]}],{t,0,2 π},PlotStyle->{Black,Thin}],ParametricPlot3D [Evaluate[{0,Cos[t],Sin[t]}],{t,0,2 π},PlotStyle->{Black,Thin}]};psaxes=Graphics3D[{Line[ps{{-1,0,0},{1,0,0}}],Line[ps{{0,-1,0},{0,1,0}}],Line[ps{{0,0,-1},{0,0,1}}],Text["(Subscript[S, x])",{lp,0,0}],Text["(Subscript[S, y])",{0,lp,0}],Text["(Subscript[S, z])",{0,0,lp}]}/.{ps-> 1.15,lp->1.3}];
poincareSphere=Graphics3D[{{Black,PointSize[0.009],Point[{0,0,1}],Point[{0,0,-1}],Point[{1,0,0}],Point[{-1,0,0}],Point[{0,1,0}],Point[{0,-1,0}]},{Opacity[0.6],Sphere [{0,0,0},1]}}];

strzalka=Graphics3D[{Thick,Blue,Arrow[Table[{Cos[t],Sin[t],0.7},{t,0,π,0.11}]]}];
circles={ParametricPlot3D [Evaluate[{WektorStokesa[[1]]Cos[t]/(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)]),WektorStokesa[[2]] Cos[t]/(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)]),Sin[t]}],{t,0,2 π},PlotStyle->{Red,Thin}],ParametricPlot3D [Evaluate[{(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)])Cos[t],(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)]) Sin[t],WektorStokesa[[3]] }],{t,0,2 π},PlotStyle->{Red,Thin}]};

(* Główny kod do rysowania transformacji na sferze Blocha *)
Manipulate[(
jones0={Cos[θ],Sin[θ] Exp[I φ]};
jonesQW1=If[q1,QR[qφ1],I1].jones0;
joneskomorka=Which[Komorka==1,I1,Komorka==2,R[obrot],Komorka==3,ZwiekszKolowa[zwiekszenie]].jonesQW1;
jonesQW2=If[q2,QR[qφ2],I1].joneskomorka;
jonesHW=If[h,HR[hφ],I1].jonesQW2;
(* polaryzacja koncowa jakby nic sie nie dzialo w komorce *)
joneskomorka0=If[h,HR[hφ],I1].If[q2,QR[qφ2],I1].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]};


TrajektoriaQW1=If[CzyTrajektoriaQW1,Graphics3D[{Red,Line [Table[N[Jones2Bloch[QR[θ].jones0]],{θ,0,180,5}]]}],{}];
TrajektoriaQW2=If[CzyTrajektoriaQW2,Graphics3D[{Cyan, Line [Table[N[Jones2Bloch[QR[θ].joneskomorka]],{θ,0,180,5}]]}],{}];
TrajektoriaHW=If[CzyTrajektoriaHW,Graphics3D[{Purple,Line [Table[N[Jones2Bloch[HR[θ].jonesQW2]],{θ,0,180,5}]]}],{}];

TrajektoriaKoncowa=
Graphics3D[{Thick,Yellow,
Line[
Which[
TrajektoriaKonc=="QW1",
Table[
Jones2Bloch[N[If[h,HR[hφ],I1].If[q2,QR[qφ2],I1].Which[Komorka==1,I1,Komorka==2,R[obrot],Komorka==3,ZwiekszKolowa[zwiekszenie]].If[q1,QR[q2φ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{q2φ1,-180,180}],
TrajektoriaKonc=="QW2",
Table[
Jones2Bloch[N[If[h,HR[hφ],I1].If[q2,QR[q2φ2],I1].Which[Komorka==1,I1,Komorka==2,R[obrot],Komorka==3,ZwiekszKolowa[zwiekszenie]].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{q2φ2,-180,180}],
TrajektoriaKonc=="HW",
Table[
Jones2Bloch[N[If[h,HR[h2φ],I1].If[q2,QR[qφ2],I1].Which[Komorka==1,I1,Komorka==2,R[obrot],Komorka==3,ZwiekszKolowa[zwiekszenie]].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{h2φ,-180,180}],
TrajektoriaKonc=="Obrot",
Table[
Jones2Bloch[N[If[h,HR[hφ],I1].If[q2,QR[qφ2],I1].R[obrot2].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{obrot2,-180,180}],
TrajektoriaKonc=="EIT",
Table[
Jones2Bloch[N[If[h,HR[hφ],I1].If[q2,QR[qφ2],I1].ZwiekszKolowa[zwiekszenie2].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{zwiekszenie2,1,10,0.1}]
]]}]  ;
TrajektoriaKoncowa0=
Graphics3D[{Thick,Orange,
Line[
Which[
TrajektoriaKonc=="QW1",
Table[
Jones2Bloch[N[If[h,HR[hφ],I1].If[q2,QR[qφ2],I1].If[q1,QR[q2φ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{q2φ1,-180,180}],
TrajektoriaKonc=="QW2",
Table[
Jones2Bloch[N[If[h,HR[hφ],I1].If[q2,QR[q2φ2],I1].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{q2φ2,-180,180}],
TrajektoriaKonc=="HW",
Table[
Jones2Bloch[N[If[h,HR[h2φ],I1].If[q2,QR[qφ2],I1].If[q1,QR[qφ1],I1].{Cos[θ],Sin[θ] Exp[I φ]}]],
{h2φ,-180,180}]
]]}]  ;
If[(TrajektoriaKonc=="Obrot")||(TrajektoriaKonc=="EIT"),TrajektoriaKoncowa0={}];




WektorStokesa0=Jones2Bloch[jones0];
WektorStokesaQW1=Jones2Bloch[jonesQW1];
WektorStokesakomorka=Jones2Bloch[joneskomorka];
WektorStokesakomorka0=Jones2Bloch[joneskomorka0];
WektorStokesaQW2=Jones2Bloch[jonesQW2];
WektorStokesa=Jones2Bloch[jonesHW]; (* To jest ta koncowa polaryzacja *)

OsObrotuQW1=Graphics3D[{Red, Dashed,Thick,Line[1.2{{Cos[2qφ1 Pi/180],Sin[2qφ1 Pi/180],0},-{Cos[2qφ1 Pi/180],Sin[2qφ1 Pi/180],0}}],StrzalkaQW[WektorStokesa0,qφ1]}];
OsObrotuQW2=Graphics3D[{Cyan, Dashed,Thick,Line[1.2{{Cos[2qφ2 Pi/180],Sin[2qφ2 Pi/180],0},-{Cos[2qφ2 Pi/180],Sin[2qφ2 Pi/180],0}}],StrzalkaQW[WektorStokesakomorka,qφ2]}];
OsObrotuHW=Graphics3D[{Purple , Dashed,Thick,Line[1.2{{Cos[2hφ Pi/180],Sin[2hφ Pi/180],0},-{Cos[2hφ Pi/180],Sin[2hφ Pi/180],0}}],StrzalkaHW[WektorStokesaQW2,hφ]}];

wielkoscsfery=0.03;
stokesVector0=Graphics3D[{Red,Sphere [WektorStokesa0,wielkoscsfery],Thickness[0.012]}];
stokesVectorQW1=Graphics3D[{Blue,Sphere [WektorStokesaQW1,wielkoscsfery],Thickness[0.012]}];
stokesVectorkomorka=Graphics3D[{Cyan,Sphere [WektorStokesakomorka,wielkoscsfery],Thickness[0.012]}];
stokesVectorkomorka0=Graphics3D[{White,Sphere [WektorStokesakomorka0,wielkoscsfery],Thickness[0.012]}];
stokesVectorQW2=Graphics3D[{Purple,Sphere [WektorStokesaQW2,wielkoscsfery],Thickness[0.012]}];
stokesVector=Graphics3D[{Green,Sphere [WektorStokesa,wielkoscsfery],Thickness[0.012]}];

Przejsciekomorka=Graphics3D[{Thick,Blue,Arrow[GenPunktyObrot[WektorStokesaQW1,WektorStokesakomorka]]}]; 

sxy=(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)]);
If[sxy==0,sxy=1]; (* Zrobione po to by program sie tutaj nie wywalal przy dzieleniu przez 0 *)
circles={ParametricPlot3D [{WektorStokesa[[1]]Cos[t]/sxy,WektorStokesa[[2]] Cos[t]/sxy,Sin[t]},{t,0,2 π},PlotStyle->{Red,Thin}],ParametricPlot3D [{(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)])Cos[t],(Sqrt[((WektorStokesa[[2]])^2)+((WektorStokesa[[1]])^2)]) Sin[t],WektorStokesa[[3]] },{t,0,2 π},PlotStyle->{Red,Thin}]};

Grid[{{Pane[Show[poincareSphere,
stokesVector0,stokesVectorQW1,stokesVectorkomorka,stokesVectorQW2,stokesVectorkomorka0,stokesVector, 
TrajektoriaQW1,TrajektoriaQW2,TrajektoriaHW,
TrajektoriaKoncowa0,TrajektoriaKoncowa,

If[q1&&PlytkiFaloweStrzalki,OsObrotuQW1,{}],If[q2&&PlytkiFaloweStrzalki,OsObrotuQW2,{}],If[h&&PlytkiFaloweStrzalki, OsObrotuHW,{}],
If[Komorka≠1,Przejsciekomorka,{}],
If[RedCircles,circles,{}],If[Osie,psaxes,{}],If[KolaWielkie,equators,{}],Boxed->False,ImageSize->900]],Pane[Show[ParametricPlot[Evaluate[
Re[Exp[I t] {jones0,jonesQW1,joneskomorka,jonesQW2,jonesHW}]],{t,0,2Pi},PlotStyle->{Red,Blue,Cyan,Purple,Green},Axes->False,PlotRange->{{-1,1},{-1,1}}]]]}}]
),
{Osie,{False,True}},
{KolaWielkie,{False,True}},
{RedCircles,{False,True}},
{θ,0,Pi,0.01},{φ,0,2Pi,0.01},{{qφ1,45},0,360,0.01},{qφ2,0,360,0.01},{hφ,0,360,0.01},
{q1,{True,False}},
{CzyTrajektoriaQW1,{False,True}},
{q2,{True,False}},
{CzyTrajektoriaQW2,{False,True}},
{h,{True,False}},
{CzyTrajektoriaHW,{False,True}},
{PlytkiFaloweStrzalki,{True,False}},
{{Komorka,2},{1->"nic",2->"Obrót",3->"Zwiększenie"} },{{obrot,10.},-90,90,0.01},{zwiekszenie,1,10},
{TrajektoriaKonc,{"QW1","QW2","HW","Obrot","EIT"}}
]