Polarizacija žarka

zarek[f_,dodatki_]:=Manipulate[
Show[{
ParametricPlot3D[
{t,f[5t,φ][[1]],f[5t,φ][[2]]},
{t,-2π,2π},
PlotRange->{{-2π,2π},{-1,1},{-1,1}},
ImageSize->Large
],
dodatki
}],{φ,0,2π}
]
zarek[{t,φ}|->Sin[t]{Cos[φ],Sin[φ]},{}]

Negacija

leca[d_,r_]:=RegionPlot3D[
((((x-d))^2)+(y^2)+(z^2)<=(r^2))&&((((x+d))^2)+(y^2)+(z^2)<=(r^2)),
{x,-1,1},{y,-1,1},{z,-1,1},
Mesh->None,
PlotStyle->Directive[Specularity[White, 2],White,Opacity[0.9]],
PlotPoints->20
]
fade[λ_,from_,to_,a_,b_]:=Which[λ<=from,a,from<λ<to,((λ-from)/(to-from))a+((to-λ)/(to-from))b,to<=λ,b]
zarek[{t,φ}|->Sin[t]fade[t,-0.1,0.1,{Cos[φ],Sin[φ]},{Sin[φ],Cos[φ]}],leca[1.5,1.8]]

Hadamardova vrata

zarek[{t,φ}|->Sin[t]fade[t,-0.1,0.1,{Cos[φ],Sin[φ]},{Cos[φ]+Sin[φ],Cos[φ]-Sin[φ]}/(Sqrt[2])],leca[1.5,1.8]]

Shorov algoritem

korenEnote[i_,n_]:={Cos[2π i/n],Sin[2π i/n]};
Manipulate[
r=MultiplicativeOrder[a,n];
sestavljena=Select[Range[3,9999,2],CompositeQ];
m=(2^q);
aaa=a;
n=sestavljena[[i]];
ah=HoldForm[x];
hn=HoldForm[y];
potence=Table[korenEnote[k i,m],{i,3,m-1,r}];
PaneSelector[{
"potence"->
Row[{
DiscretePlot[PowerMod[a,i,n],{i,1,m},ImageSize->Large,PlotStyle->Orange],
Multicolumn[
Table[
((TraditionalForm[PowerMod[HoldForm[x],i,n]])/.x->a)==PowerMod[a,i,n],
{i,1,m}
],
5,
Spacings -> {1,1},Background -> {Automatic,{{LightOrange,White}}},Frame->All,FrameStyle -> White
]
}],
"razcep"->
Style[Column[TraditionalForm/@{
PowerMod[ah,r,n]==1,
Mod[Power[ah,r]-1,n]==0,
Mod[(Power[ah,r/2]-1)(Power[ah,r/2]+1),n]==0,
Mod[Power[ah,r/2]-1,n]==Mod[Power[a,r/2]-1,n],
Mod[Power[ah,r/2]+1,n]==Mod[Power[a,r/2]+1,n],
GCD[Mod[Power[a,r/2]-1,n],hn]==GCD[Power[a,r/2]-1,n],
GCD[Mod[Power[a,r/2]+1,n],hn]==GCD[Power[a,r/2]+1,n]
},Center],Large],
"koreniEnote"->
Row[{
Manipulate[
Graphics[{
PointSize[Small],
Table[Point[korenEnote[i,m]],{i,b,m-1}],
PointSize[Large],
Table[{Blend[{Red,Blue},i/m],Point[korenEnote[k i,m]]},{i,b,m-1,r}],
Table[{Blend[{Red,Blue},i/m],Text[Style[i,Medium],0.9korenEnote[k i,m]]},{i,b,m-1,r}],
Orange,
PointSize[0.05],
Point[Mean[Table[korenEnote[k i,m],{i,b,m-1,r}]]]
},ImageSize->All],{{k,1,Style["hitrost",Large]},1,m},{{b,0,Style["zamik",Large]},0,r-1,1}],
w=(E^(2π I/m));ListPlot[Table[Abs[N[Sum[(w^(l i)),{i,0,(m-1),r}]]/(m(Sqrt[m]))],{l,0,m-1}],ImageSize->Large,Filling->Axis,PlotRange->All,PlotStyle->Orange]
}
]
},zavihek]/.{x->a,y->n},
{{i,3,Style[Dynamic[n],Large]},1,Length[Evaluate[sestavljena]],1},
{{a,10,Style[Dynamic[aaa],Large]},2,n,1},
{{q,6,Style[Dynamic[m],Large]},3,10,1},
{{zavihek,"potence"},{"potence","razcep","koreniEnote"},Style->Large}
]