1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
|
#############################################################################
##
#W factor.gi The Congruence package Helena Verrill
##
##
#############################################################################
# it will be useful to find the maximum value of the labels
# though if space is not a problem, this could just return
# the Length of the labels.
__congruence_max_label:= function(L)
local s, i;
s:=1;
for i in [1..Length(L)] do
if (not L[i] = "even") and (not L[i] = "odd") and L[i] > s then
s := L[i];
fi;
od;
return s;
end;;
# For a list of labels L such as
# [1,3,4,7,4,7,3,1,"odd","even"], for reference, indices are:
# 1 2 3 4 5 6 7 8 9 10
# want to produce a list:
# [[9],[10],[1,8],[],[2,7],[3,5],...]
# this is the list of the form:
# [[all indices with L[x] = "odd"],[all indices with L[x] = "even"],
# [all indices with L[x] = 1], ....]
# assume L is a list of integers, or "odd" or "even".
__congruence_edgepairs := function(L)
local max, pairs, i;
pairs:=[];
max:=__congruence_max_label(L);
for i in [1..max+2] do
pairs[i] := [];
od;
for i in [1..Length(L)] do
if L[i]="odd" then
Add(pairs[1],i);
elif L[i]="even" then
Add(pairs[2],i);
else
Add(pairs[L[i]+2],i);
fi;
od;
return pairs;
end;;
# for each edge of a Farey Symbol, we compute the generator
# which maps that edge to another edge.
# (this is done at the same time as the fundamental
# domain is computed, but the data may not have been stored,
# and has to be recomputed; suggest change for a future version)
# this function gives "edge gluing matrices" as a number in the
# list of generators (gens); negative entries mean the inverse matrix,
# e.g., -5 would mean (5th generator)^(-1)
# (note, the list of labels in a Farey sequence says which edge is
# glued to which; -2 and -3 means there is an elliptic point order
# 2 or 3)
#
# the input is assumed to be a FareySymbol;
# another version of this function could take input to be the group
#
# Note, if the output of this function was
# stored as an attribute of the FareySymbol,
# then it would not have to be recomputed
#
__congruence_gluing_matrices := function(FS)
local cusps, gens, label_list, glue_list, l, i, index, gfs, labels, matrix;
# the following is a list of the cusps of the sequence,
# and other data extracted from the FareySymbol
gfs := GeneralizedFareySequence(FS);
labels := LabelsOfFareySymbol(FS);
gens := GeneratorsByFareySymbol( FS );
# make a list of which edges have a given label:
label_list := __congruence_edgepairs(labels);
# the following list will be what is finally returned,
# a list of integers as described above.
glue_list := [];
# make list of which generator joins two edges,
# in the non elliptic case
for i in [3..Length(label_list)] do
l := label_list[i];
matrix := MatrixByFreePairOfIntervals( gfs, l[1], l[2] );
index := PositionNthOccurrence( gens ,matrix,1);
if index = "fail" then
index := -PositionNthOccurrence(gens,matrix^(-1),1);
fi;
glue_list[l[1]] := index;
glue_list[l[2]] := -index;
od;
# Now deal with elliptic elements:
for i in label_list[1] do
matrix := MatrixByOddInterval( gfs, i );
index := PositionNthOccurrence(gens,matrix,1);
if index = "fail" then
index := -PositionNthOccurrence(gens,matrix^(-1),1);
glue_list[i] := -index;
else
glue_list[i] := -index;
fi;
od;
for i in label_list[2] do
matrix := MatrixByEvenInterval( gfs, i );
index := PositionNthOccurrence(gens,matrix,1);
if index = "fail" then
index := -PositionNthOccurrence(gens,matrix^(-1),1);
glue_list[i] := -index;
else
glue_list[i] := -index;
fi;
od;
return glue_list;
end;;
# following function determines which edge an image ImL of
# a domain is the longest
#
# The function either returns a index of an edge
# which is a number between 1 and #L-1,
# or it returns "overlap" meaning that there is overlap, but not equality.
__congruence_longest_edge := function(ImL)
local i, minImL, maxImL, maxindex, minindex;
for i in [1..Length(ImL)] do
if ImL[i] = infinity then
return "infinity";
fi;
od;
minImL := Minimum(ImL);
maxImL := Maximum(ImL);
maxindex := PositionNthOccurrence( ImL ,maxImL,1);
return maxindex;
end;;
# Need to be able to apply action of matrices to cusps
__congruence_fractionallineartransformation:= function(g,c)
local den, num;
if c = infinity then
if g[2][1] = 0 then
return infinity;
else
return g[1][1]/g[2][1];
fi;
else
num:=g[1][1]*c + g[1][2];
den:=g[2][1]*c + g[2][2];
if den = 0 then
return infinity;
else
return num/den;
fi;
fi;
end;;
__congruence_PSL2multiply := function(g,L)
local imL, i;
imL := [];
for i in [1..Length(L)] do
Add(imL,__congruence_fractionallineartransformation(g,L[i]));
od;
return imL;
end;;
# this an algorithm to determine a word for
# a given matrix g in G in terms of the generators:
find_word_ver2 := function(FS,glue_list,g)
local gens, L, ImL, done, word,letter,i, edge, h, maybesame, inf;
gens := GeneratorsByFareySymbol( FS );
L := GeneralizedFareySequence( FS );
ImL := __congruence_PSL2multiply(g,L);
word:=[];
h := g;
done := false;
while not done do;
edge := __congruence_longest_edge(ImL);
if edge = "infinity" then
# check equality of L and ImL:
maybesame := true;
i := 1;
while i < Length(L) and maybesame do
if not L[i] = ImL[i] then
maybesame := false;
fi;
i := i+1;
od;
if maybesame then
done := true;
return Reversed(word);
fi;
# now assume the domains are not equal
inf := PositionNthOccurrence( ImL , infinity ,1);
if inf = 1 and
ImL[2]<L[Length(L)-1] and
ImL[Length(L)-1]>L[2] then
return "g is not in the group";
elif
ImL[i+1]<L[Length(L)-1] and
ImL[i-1]>L[2] then
return "g is not in the group";
fi;
# now assume the domains do not overlap
if ImL[inf+1] >= L[2] then
letter := glue_list[inf];
elif inf = 1 then
letter := glue_list[Length(glue_list)];
else
letter := glue_list[inf-1];
fi;
Add(word,letter);
h:=h*gens[AbsoluteValue(letter)]^(-SignInt(letter));
ImL := __congruence_PSL2multiply(h,L);
else
# get next "letter" in the word for the matrix:
letter := glue_list[edge];
Add(word,letter);
h:=h*gens[AbsoluteValue(letter)]^(-SignInt(letter));
ImL := __congruence_PSL2multiply(h,L);
fi;
od;
return Reversed(word);
end;;
#############################################################################
#
# FactorizeMat( G, g )
#
__congruence_FactorizeMat := function( G, g )
return find_word_ver2( FareySymbol(G),
__congruence_gluing_matrices(FareySymbol(G)),
g );
end;
#############################################################################
#
# CheckFactorizeMat(gens,word)
#
# the following function is for testing purposes:
# gens is a list of generators, "word" a sequence of integers, none
# of which is bigger than the size of the list of generators.
# a word [4,6,-3] will return the product gens[4]*gens[6]*gens[3]^(-1)
#
__congruence_CheckFactorizeMat := function(gens,word)
local g, i;
g := [[1,0],[0,1]];
for i in word do
g := g*gens[AbsoluteValue(i)]^SignInt(i);
od;
return g;
end;
|
