A strange generalization algebra for pseudo-permutation
like Pisot matrices to a transvection type of transformation.
Somewhat like a Boolean "product" is an "And" operation:
this is a defined power operation for a Substitution like algebra based on
permutations as being identity matrix like.
Since the original matrix gives the Akiyama-Thurston Pisot ( fractal)
tile,
There is a possiblity that the substitution on the matix :
{{m, 0, 1},
{1, 0, 0},
{0, 1, 0}}
substitution:
1-> m*1,3
2->1
3->2
characteristic polynomial:
x3-n*x^2-1
might also be connected to a sequence of ( toral) tiles.
The root system of the polynomial does appear to be Pisot like.
%I A000001
%S A000001 0, 1, 2, 6, 25, 127, 768, 5401, 43335, 390783, 3913231,
43088876, 517457295, 6730858066, 94275101800, 1414643984295,
22641034606786, 384991863417162, 6931268185493211, 131716736558977795,
2634719723042973062, 55336045452087927513, 1217524716682493383081,
28005703203420390783925, 672192212927541466741713,
16806022847905219161925906, 436984599748739118600857481,
11799256385428883743689893700, 330395984814856650042478949506,
9581920544230591590350490393155, 287469415583303176594258401688350
%N A000001 A doubly recursive vector matrix Markov with charactersistic
polynomial:
1 + n x^2 - x^3
Based on matrices of the form:
M(n)={{n, 0, 1},
{1, 0, 0},
{0, 1, 0}};
%C A000001 I call this the minimal Pisot based transvective sequence.
Transvection is a matrix type in group theory:
It is an identity matrix plus one off diagonal term:
T(i,j,a)=Ident+E(i,j,a)
These matrices have a couple of unique properties:1)
1) inverse
T(i,j,a)^(-1)=Ident+E(i,j,-a)
2) matrix power
T(i,j,a)^(m)=Ident+E(i,j,m*a)
If you look at the matrix for the minimal Pisot polynomial:
( which I have called a pseudo-permutaion matrix before)
M = {{0, 1, 0},
{0, 0, 1},
{1, 1, 0}}
CharacteristicPolynomial[M, x]
1 + x - x3
MatrixPower[M, -1]
{{-1, 0, 1},
{1, 0, 0},
{0, 1, 0}}
So the matrix power equivalent would just be the matrix M(n)
I am using. It involves a new way to look at the algebra involved
in a Markov sequence.
%F A000001 M(0)={{0, 1, 0},
{0, 0, 1},
{1, 1, 0}};
M(n)={{n, 0, 1},
{1, 0, 0},
{0, 1, 0}};
v(n)=M(n)*v(n-1)
a(n) = v(n-1)[[1]]
%t A000001 M[0] = {{0, 1, 0},
{0, 0, 1},
{1, 1, 0}};
M[n_] := {{n, 0, 1},
{1, 0, 0},
{0, 1, 0}};
v[0] = {0, 0, 1};
v[n_] := v[n] = M[n].v[n - 1];
a = Table[v[n][[1]], {n, 0, 30}]
%O A000001 1
%K A000001 ,nonn,
%A A000001 Roger L. Bagula (rlbagulatftn@[EMAIL PROTECTED]
), Jun 18 2007
RH RA 192.20.225.32
RU RI
I went looking for fractals or tiles associated with the transvection
type polynomials
and found this very von Koch like set ( sort of a von Koch plus).
It has been known that such sets were associated to Pisots tiles, but
no good isolated procedure was know to kool at them until now.
Since a tile has dimension 2 and the von Koch is near Log[4]/Log[3]
and these sets appear in McWorter's holes L- systems,
one can think of them a like sub-groups in classical
group theory.
I made a movie which is up here of a Riddle rotation transform:
http://www.mathematica-users.org/mediawiki/images/7/77/transvection_animation.avi
I got the fractals sets two ways in Mathematica:
Mathematica code: t=1 code: animation varies t in the Riddle
transformation
(* minimal Pisot von Koch fractal {2, 3] type definition in Mathematica*)
x3 = -0.573949517852393;
y3 = 0.3689894074818047;
x5 = 0.42605048214760677;
y5 = 0.42605048214760677;
t = 1;
aa = (x*x5 - y*y5);
bb = (x*y5 + y*x5);
cc = Cos[t*Pi];
ss = Sin[t*Pi];
x1 = aa*cc - bb*ss + x5 + (x5)*t;
y1 = aa*ss + bb*cc + y5 - (x5)*t;
(* Wellin IFS program type*)
(* Akiyama_23 : curley tile*)
f1[{x_, y_}] = {x*x3 - y*y3 + x3, x3*y + y3*x + y3};
f2[{x_, y_}] = {x1, y1};
f[x_] := Which[(r = Random[]) <= 1/2, f1[x],
r <= 1.00, f2[x]] ifs[n_] := Show[Graphics[{PointSize[.001],
Map[Point, NestList[f, {0, 0}, n]]}],
PlotRange -> All, AspectRatio -> Automatic]
ifs[20000]
Mathematica code using McClure's DigraphFractals:
n = 1
f0[x_] = x3 - n*x2 - 1
z = x /. NSolve[x3*f0[1/x] == 0, x][[1]]
c = Re[n/z2]
s = Im[n/z2]
c1 = N[Re[1/z3]]
s1 = N[Im[1/z3]]
rotate[theta_] := {{Cos[theta], -Sin[theta]},
{Sin[theta], Cos[theta]}};
f = {{{c, -s}, {s, c}}, {c, s}};
g = {{{c1, -s1}, {s1, c1}}, {c1, s1}};
Needs["DigraphFractals`"];
terdragonDigraph = {{{f, g}}}
ShowDigraphFractals[terdragonDigraph, 15];
Further investigation of the transvection of Pisots algebra gives some
results.
The difference matrix:
M[n_] := MatrixPower[{{0, 1, 0},{0, 0, 1},{1, 1, 0}}, n] - {{n, 0,
1},{1, 0, 0},{0, 1, 0}}
Determinants: ( they seem to alternate signs at the begiining)
a = Table[Det[M[n]], {n, -1, 30}]
{0, 0, 1, -2, 1, 1, -11, 8, -19, -17, 1, -76, -13, -90, -160, -74, -363,
-288, -461, -911, -745, -1672, -2001, -2529, -4525, -4874, -7929, -10916,
-13568, -21604, -26743, -38222}
To show their relationship to permutaions ( Schubert varieties):
v[1] = {0, 0, 1};
v[n_] := v[n] = M[n].v[n - 1]
a = Table[(n - 1)! - Abs[v[n][[1]]], {n, 1, 30}]
{1, 1, 1, 1, 6, 20, 168, 964, 15500, 58808, 2910624, -22827204,
-865887384,
-76665475368, -5305689674928, -485796314493696, -57911683682514432,
-9137529320606386512, -1910718244863955270680, -529378391108813504375400,
-194321694876121073811316560, -94503646790362171973206467000,
-60883133878175612380930700325000, -51959515571431301010888324628043400,
-58740861723499165661900727778953277200,
-87966601873256853344272829715931695382800,
-174500956653377949682874905309260248248617600,
-458542724380654661534598749052719239044812001600,
-1596120596927030506260796049891227650226996484908800,
-7359655574996716882788016068602659375774141106103705600}
I was just trying to fill in my knowledge of acedemic group theory
and this idea came up.
The root structure gives Frougney beta sequence type three real roots
after n=3:
Table[NSolve[CharacteristicPolynomial[M[n], x] == 0, x], {n, -1, 10}]
{{{x -> 0.}, {x -> 0.}, {
x -> 0.}}, {{x -> 0.}, {x ->
1.5\[InvisibleSpace] - 0.866025 \[ImaginaryI]}, {x ->
1.5\[InvisibleSpace] + 0.866025 \[ImaginaryI]}}, {{x -> -0.696323 -
1.43595 \[ImaginaryI]}, {
x -> -0.696323 + 1.43595 \[ImaginaryI]}, {x -> 0.392647}}, {{
x -> -2.}, {x -> 1.}, {x -> 1.}}, {{x -> -0.662359 - 0.56228
\[ImaginaryI]}, {x -> -0.662359 + 0.56228 \[ImaginaryI]}, {x ->
1.32472}}, {{
x -> -3.95759}, {x -> -0.121532}, {
x -> 2.07912}}, {{x -> -3.97114}, {x -> 0.902746}, {x ->
3.0684}}, {{x -> -4.81129}, {x -> -0.395276}, {x ->
4.20657}}, {{x -> -6.32487}, {x ->
0.517254}, {x -> 5.80762}}, {{x -> -6.32713}, {x ->
0.336238}, {x -> 7.99089}}, {{x -> -7.83394}, {
x -> -0.0117696}, {x -> 10.8457}}, {{x -> -8.34715}, {x -> 0.618163},
{x
-> 14.729}}}
Almost too strange to be interesting.
|
