You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
q
k
O
k
u
u
f
k
T
O
k
F
k
f
k
u
1
2
4-1+2
2
f
k
2
(Δ)
F
2
(·Δ)
F
F
2
F
F
F
In[]:=
exp
∮dθ(θ)·(θ)
′
C
F
2ν(t+)
t
0
F
lim
N∞
exp
Δ·
N-1
∑
k0
C
k
F
k
2ν(t+)
t
0
F
C
k
C
(2k+1)π
N
C
(2k-1)π
N
In[]:=
C
θ
C
k
π
N
2πk
N
2πk
N
In[]:=
Eq=Expand[(f.q+1/2)^2==(f.f+f.q+1/4)+I(f.q+1/2)]
Out[]=
1
4
2
(f.q)
1
4
2
In[]:=
Solve[Eq,f.q]
Out[]=
f.q-+
1
2
(-1+2)+4f.f
,f.q1
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[]:=
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[]=