Wolfram Cloud Document

q

k





O

k

·

u

(α,γ);

u

(α,γ)\[NewLine]{cosh(γ)cos(α),cosh(γ)sin(α),sinh(γ)}



f

k



T



O

k

·

F

k

;



f

k

·

u

(α,γ)

1

2

±

4

2



f

k

-1+2

2

(Δ

F

)

1;

2

(

F

·Δ

F

)



2

F

+

F

·Δ

F

In[]:=

exp

∮dθ

′

C

(θ)·

F

(θ)

2ν(t+

t

0

)

F



lim

N∞

exp



N-1

∑

k0

Δ

C

k

·

F

k

2ν(t+

t

0

)

F

;\[NewLine]Δ

C

k



C

(2k+1)π

N

-

C

(2k-1)π

N

;

In[]:=

C



θ

R{cosθ,sinθ,0};Δ

C

k

2Rsin

π

N

\[NewLine]-sin

2πk

N

,cos

2πk

N

,0

In[]:=

Eq=Expand[(f.q+1/2)^2==(f.f+f.q+1/4)+I(f.q+1/2)]

Out[]=

1

4

+f.q+

2

(f.q)



1

4

+



2

+f.f+(1+)f.q

In[]:=

Solve[Eq,f.q]

Out[]=

f.q

1

2

-

(-1+2)+4f.f

,f.q

1

2

+

(-1+2)+4f.f



In[]:=

DC[k_,M_]:=2Sin[Pi/M]{-Sin[2Pik/M],Cos[2Pik/M],0};

In[]:=

RandomInitialF0:=f0=RandomReal[{-1,1},3]+I{RandomReal[{-1,1}],RandomReal[{0,1}],RandomReal[{-1,1}]};

In[]:=

ArgMinList[L_List]:=Position[L,Min@@L];ArgMaxList[L_List]:=Position[L,Max@@L];MyNorm[V_]:=Evaluate[Sqrt[Re[V].Re[V]+Im[V].Im[V]]];MySqr[V_]:=Evaluate[Re[V].Re[V]+Im[V].Im[V]];

In[]:=

XY[R_,{a_,b_,c_},z_]:=Inverse[{{Re[a],Re[b]},{Im[a],Im[b]}}].{Re[R]-zIm[c],Im[R]+zRe[c]};

QSol[f_,σ_]:=Block[{x,y,z},{x,y}=XY[1/2(I+σSqrt[4f.f-1+2I]),f,z];{x,y,Iz}/.Solve[x^2+y^2-z^2==1,{z}]]//Quiet;

In[]:=

NumericVectors[X_List]:=Select[X,#==Select[#,NumericQ]&]

In[]:=

NumericVectors[{{1,2,3},{a,2,4},{I,2,6}}]

Out[]=

{{1,2,3},{,2,6}}

In[]:=

(#.#)&/@QSol[{1,I,3},-1]//Simplify

Out[]=

{1,1}

In[]:=

RandomChoice[{1}]

Out[]=

1

In[]:=

ClearAll[RW];

In[]:=

RW[M_,f0_]:=Block[{dist,f,flist,O,f1,q,qq,X,n,norms},f=f0;flist={f};dist=CircularRealMatrixDistribution[3];For[k=0,k<M,k++,O=RandomVariate[dist];f1=Transpose[O].f;X=Join[QSol[f1,-1],QSol[f1,1]];qq=NumericVectors[Select[X,Re[#[[3]]]==0&]];If[Length[qq]>0,(*Echo[Length[qq],"qq after real beta selected :"];*)qq=NumericVectors[Select[qq,Im[(f+O.#)].DC[Length[flist],M]>=0&]];(*Echo[Length[qq],"qq after Im F DC >0 selected :"];*)If[Length[qq]>0,norms=MyNorm[#]&/@qq;f+=O.qq[[ArgMinList[norms][[1,1]]]];AppendTo[flist,f]];(*If*)(*Echo[Length[flist],"flist:"];*)];];(*While*)flist];(*Block*)

In[]:=

StatisticalDistributions[M_,L_,K_,WhichTable_]:=Block[{stats,l,datas,names},datas=Transpose[WhichTable[Block[{f0,rw},f0=RandomInitialF0;rw=RW[M,f0];{Log[MyNorm[rw[[#]]-f0]]&/@Range[K,Length[rw]],MyNorm[rw[[#]]-rw[[#-1]]]&/@Range[K,Length[rw]],Re[-(Cross[rw[[#]],rw[[#-1]]])^2]&/@Range[K,Length[rw]]}],{l,L}]];names={"walk","step",κ};{datas,names}];

In[]:=

{datas,names}=StatisticalDistributions[1000,10000,10,ParallelTable];

In[]:=

Dimensions[datas]

Out[]=

{3,10000}

In[]:=

WalkPlot[stat_,part_,funcs_]:=Block[{gaps,CDFTail,ld,mlen,tail,model,x},mlen=Floor[Mean[Length[#]&/@stat]];(*Echo[mlen];*)gaps=#[[;;mlen]]&/@Select[stat,Length[#]>=mlen&];(*Echo[Dimensions[gaps]];*)ld=Mean[#]&/@Transpose[gaps];data=Transpose[{Log[Range[mlen]],ld}];tail=Floor[partmlen];model=LinearModelFit[data[[-tail;;]],funcs,ξ];Print["random walk :"];Print[Quiet[model["ParameterTable"]]];Show[ListPlot[data[[-tail;;]],PlotStyle{Red,Thick},PlotLegends->{"data"}],Plot[model["BestFit"],{ξ,Log[mlen-tail],Log[mlen]},PlotStyle{Blue,Dashed},PlotLegends->{"fit"}],PlotLabel->model["BestFit"]/.ξ->Log[Steps],AxesLabel->{Log[Steps],Log[Dist]},PlotRange->Full]];

In[]:=

WalkPlot[datas[[1]],1/6,{1,ξ}]

random walk :

	Estimate	Standard Error	t-Statistic	P-Value
1	-1.51345	0.037324	-40.5488	1.99343× -28 10
ξ	0.831889	0.00713645	116.569	1.5485× -42 10

Out[]=

data

fit