14-Sets supplementary code and data II

Let’s test the package 14Sets.m :

<<"Desktop/Braids/14Sets.m"

kuraTable[]

(Underscript[1, 14])

140σ

(Subscript[σ, 6])(Subscript[σ, 5])

(Underscript[(L^(1,3)), 3]) //MatrixForm

|141x>

<(Underscript[1, 14])|

<(Underscript[1, 14]) | 140x>

<(Underscript[1, 3]) |(E^(Underscript[(L^(1,3)), 3]))|30x>

<(Underscript[1, 3]) |(E^(Underscript[(L^(1,3)), 3]))

(E^(Underscript[(L^(1,3)), 3]))//MatrixForm

<(Underscript[1, 3])|(E^(Underscript[(L^(1,2)), 3]))|30(x^2)>

cfs=rand14SetsStoch[]

v=MatrixRep14Sets[cfs];
v//MatrixForm
Style[v//MatrixForm,FontSize->7]

vINF=MatrixPower[v,6];
Style[vINF//MatrixForm,FontSize->8]

These are writting for simulate the voltage distributions for Ganglion cells based upon 14-Sets algebra:

makeVoltageOutput[n0_]:=Module[{cfs,v,vINF,mat,n=n0},
cfs=rand14SetsStoch[];
v=MatrixRep14Sets[cfs];
vINF=MatrixPower[v,100];
mat=Sum[MatrixPower[v,i+1], {i, 1, n}]-(n-1)*vINF;
Norm[mat]

]

makeVoltageOutput2[]:=Module[{cfs,v,vINF,mat},
cfs=rand14SetsStoch[];
v=MatrixRep14Sets[cfs];
vINF=Chop[MatrixPower[v,20]];
mat=MatrixPower[v,2]+MatrixPower[v,3]-vINF;
Norm[mat]

]

makeVoltageOutput3[]:=Module[{cfs,v,vINF,mat},
cfs=rand14SetsStoch[];
v=MatrixRep14Sets[cfs];
vINF=MatrixPower[v,100];
mat=MatrixPower[v,2]-vINF;
Norm[mat]

]

makeVoltageOutput4[]:=Module[{cfs,v,vINF,mat},
cfs=rand14SetsStoch[];
v=MatrixRep14Sets[cfs];
mat=v;
Norm[mat]

]


makeVoltageOutput5[]:=Module[{cfs,v,vINF,mat},
cfs=rand14SetsStoch[];
v=MatrixRep14Sets[cfs];
vINF=MatrixPower[v,100];
mat=vINF;
Norm[mat]

]

vINFCommute[]:=Module[{cfs1,v1,vINF1,cfs2,v2,vINF2,mat},
cfs1=rand14SetsStoch[];
v1=MatrixRep14Sets[cfs1];
vINF1=MatrixPower[v1,100];
cfs2=rand14SetsStoch[];
v2=MatrixRep14Sets[cfs2];
vINF2=MatrixPower[v2,100];
mat=vINF1.vINF2-vINF2.vINF1;
Norm[mat]

]

σExpr[cfs]
σMatrix[v]
σMatrix[vINF]

(* v^2 *)
signal=Table[makeVoltageOutput[1], {i,1, 5000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,5000},{0,2}}]
Mean[signal]
StandardDeviation[signal]

signal=Table[makeVoltageOutput[2], {i,1, 5000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,5000},{0,2}}]
Mean[signal]
StandardDeviation[signal]
Max[signal]

signal=Table[makeVoltageOutput[3], {i,1, 5000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,5000},{0,2}}]
Mean[signal]
StandardDeviation[signal]
Max[signal]

signal=Table[makeVoltageOutput[90], {i,1, 5000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,5000},{0,2}}]
Mean[signal]
StandardDeviation[signal]
Max[signal]

(* v *)
signal=Table[makeVoltageOutput4[], {i,1, 5000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,5000},{0,2}}]
Mean[signal]
StandardDeviation[signal]

(* vINF *)
signal=Table[makeVoltageOutput5[], {i,1, 50000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,50000},{0,2}}]
Mean[signal]
StandardDeviation[signal]
Max[signal]
Min[signal]

(*v^2-vINF*)
signal=Table[makeVoltageOutput3[], {i,1, 5000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,5000},{0,2}}]
Mean[signal]
StandardDeviation[signal]

signal=Table[vINFCommute[], {i,1,500000}];
ListLinePlot[signal,AxesOrigin->{0,0}, PlotRange->{{0,500000},{0,4}}]
Mean[signal]
StandardDeviation[signal]
Max[signal]
Min[signal]

Therorem 2.2 proof symbolic computations:

x=.;
w=(x/14)*{1,1,1,1,1,1,1,1,1,1,1,1,1,1};
v=MatrixRep14Sets[w];
n=.;
wpower = MatrixPower[v,n];

Simplify[wpower/.{(0^n)->0,(0^(1+n))->0},Assumptions->n>1]//MatrixForm

x=.;
w=(x/6)*{1,1,1,1,1,1,0,0,0,0,0,0,0,0};
v=MatrixRep14Sets[w];
n=.;
wpower = MatrixPower[v,n];

Simplify[wpower/.{(0^n)->0,(0^(1+n))->0},Assumptions->n>1]//MatrixForm

Example where the upporbounds of for the last 8 coefficients are not 1/8:

x=.;
w=(x/3)*{1,1,0,0,0,1,0,0,0,0,0,0,0,0};
v=MatrixRep14Sets[w];
n=.;
wpower = MatrixPower[v,n];

Simplify[wpower/.{(0^n)->0,(0^(1+n))->0},Assumptions->n>1]//MatrixForm
x=1;
Limit[wpower,n->Infinity]//MatrixForm

w={0,0,0,0,0,0,g,h,i,j,k,l,m,n};
v=MatrixRep14Sets[w];
nn=14;
wpower = MatrixPower[v,nn];

Expand[wpower[[7]][[1]]-wpower[[11]][[1]]]

Expand[wpower[[8]][[1]]-wpower[[12]][[1]]]

v0=v/.{a->0,b->0,c->0,d->0,e->0,f->0, g->α, h->β, i->ω, j->η,  k->α, l->β, m->ω, n->η};
v0//MatrixForm

v0=v/.{a->0,b->0,c->0,d->0,e->0,f->0, g->α, h->β, i->ω, j->(-(α+β+ω)+(1/2)),  k->α, l->β, m->ω, n->(-(α+β+ω)+(1/2))};

poly=Simplify[CharacteristicPolynomial[v0, λ]]

w={a,1-a,0,0,0,0,0,0,0,0,0,0,0,0};
vdisc=MatrixRep14Sets[w];
nn=24;
wpower = MatrixPower[vdisc,nn];

Expand[wpower[[1]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[2]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[3]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[4]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[5]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[6]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[7]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[8]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[9]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[10]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[11]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[12]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[13]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[14]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[7]][[1]]-wpower[[11]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[8]][[1]]-wpower[[12]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[9]][[1]]-wpower[[13]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[10]][[1]]-wpower[[14]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]

w1={a,b,0,0,0,0,0,0,0,0,0,0,0,0};
w2={a2,b2,0,0,0,0,0,0,0,0,0,0,0,0};
vdisc1=MatrixRep14Sets[w1];
vdisc2=MatrixRep14Sets[w2];
vdisc1.vdisc2 //MatrixForm
vdisc1.vdisc2- vdisc2.vdisc1//MatrixForm

w1={a,b,c,d,e,f,g,h,i,j,k,l,m,n};
w2={a2,b2,0,0,0,0,0,0,0,0,0,0,0,0};
vdisc1=MatrixRep14Sets[w1];
vdisc2=MatrixRep14Sets[w2];
vdisc1.vdisc2 //MatrixForm
vdisc1.vdisc2- vdisc2.vdisc1//MatrixForm

Solve[vdisc1.vdisc2- vdisc2.vdisc1==ConstantArray[0,14], {a2,b2}]

v1=a (Subscript[σ, 0])+b (Subscript[σ, 1])+c (Subscript[σ, 2])+d (Subscript[σ, 3])+e (Subscript[σ, 4])+f (Subscript[σ, 5])+g (Subscript[σ, 6])+h (Subscript[σ, 7])+i (Subscript[σ, 8])+j (Subscript[σ, 9])+k (Subscript[σ, 10])+l (Subscript[σ, 11])+m (Subscript[σ, 12])+n (Subscript[σ, 13]);
v1=v0/.{η->(-(α+β+ω)+(1/2))}
Solve[v1.v1.v1.v1== v1, {α,β,ω},Complexes]

vinf=Simplify[ v1/.{ω->((α-2 (α^2)-2 α β)/(2 (α+β)))}];
vinf//MatrixForm

Simplify[CharacteristicPolynomial[vinf, λ]]

Eigenvalues[Transpose[vinf]]
Eigenvectors[Transpose[vinf]]

Plot3D[((α-2 (α^2)-2 α β)/(2 (α+β))), {α,0.0000000001, 0.5}, {β,0.0000000001, 0.5},PlotRange->0.5,AxesLabel->{α,β}]

vinf2=vinf/.{α->α1,β->β1};

Simplify[vinf2.vinf- vinf.vinf2]//MatrixForm

Solve[vinf2.vinf- vinf.vinf2==ConstantArray[0,14], {α,β}]

v1power[[All,1]]

Log[10,35184367894528.0]

Expand[wpower[[1]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[2]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[3]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[4]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[5]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[6]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[7]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[8]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[9]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[10]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[11]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[12]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[13]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[14]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[7]][[1]]-wpower[[11]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[8]][[1]]-wpower[[12]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[9]][[1]]-wpower[[13]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[10]][[1]]-wpower[[14]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]

Log[10,140737479966720.0]

Expand[wpower[[1]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[2]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[3]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[4]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[5]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[6]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[7]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[8]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[9]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[10]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[11]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[12]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[13]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[wpower[[14]][[1]]/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[7]][[1]]-wpower[[11]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[8]][[1]]-wpower[[12]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[9]][[1]]-wpower[[13]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]
Expand[(wpower[[10]][[1]]-wpower[[14]][[1]])/.{a->x,b->x, c->x, d->x,e->x, g->x,h->x,k->x,l->x,i->x,j->x,m->x,n->x,f->x}]