Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

563603 views
1
#include"typedef.h"
2
/**************************************************************************\
3
@---------------------------------------------------------------------------
4
@---------------------------------------------------------------------------
5
@ FILE: pair_red.c
6
@---------------------------------------------------------------------------
7
@---------------------------------------------------------------------------
8
@
9
\**************************************************************************/
10
11
12
static void two_reduce(G, T, i, j, n)
13
int **G, **T, i, j, n;
14
{
15
int k, f;
16
17
if(G[i][j] > 0)
18
f = (G[i][j] + G[i][i]/2)/G[i][i];
19
else
20
f = (G[i][j] - G[i][i]/2)/G[i][i];
21
22
for(k=0;k<n;k++)
23
G[j][k] -= f * G[i][k];
24
G[j][j] -= f * G[j][i];
25
for(k=0;k<n;k++)
26
{
27
if(k != j)
28
{
29
G[k][j] = G[j][k];
30
}
31
}
32
for(k=0;k<n && T != NULL;k++)
33
T[j][k] -= f * T[i][k];
34
}
35
36
37
/**************************************************************************\
38
@---------------------------------------------------------------------------
39
@ void pr_red(G, T, n)
40
@ int **G, **T, n;
41
@
42
@ applies a pair_reduction to the 2-dimensional array G of size n x n
43
@ and makes the simutaneous row operations on the array T of the same size
44
@ The function can be called with T = NULL
45
@---------------------------------------------------------------------------
46
@
47
\**************************************************************************/
48
void pr_red(G, T, n)
49
int **G, **T, n;
50
{
51
int i,j,k, a;
52
int reduced, red2;
53
int merk, s, p1, p2;
54
55
reduced = FALSE;
56
reduction_sort(G,T,n);
57
while(reduced == FALSE)
58
{
59
reduced = TRUE;
60
for(i=0;i<n;i++)
61
for(j=0;j<i;j++)
62
{
63
red2 = FALSE;
64
while(red2 == FALSE && (G[i][i] != 0 || G[j][j] != 0))
65
{
66
if(G[i][i] > 0 && G[i][i] <= G[j][j])
67
{
68
a = 2*G[i][j];
69
if(abs(a) > G[i][i])
70
{
71
two_reduce(G, T, i, j, n);
72
reduced = FALSE;
73
}
74
else
75
red2 = TRUE;
76
}
77
if(G[j][j] > 0 && G[j][j] <= G[i][i])
78
{
79
a = 2*G[i][j];
80
if(a > G[j][j] || -a > G[j][j])
81
{
82
two_reduce(G, T, j, i, n);
83
reduced = FALSE;
84
}
85
else
86
red2 = TRUE;
87
}
88
if(G[i][i] < 0 || G[j][j] < 0)
89
return;
90
}
91
}
92
reduction_sort(G, T, n);
93
for(i=0;i<n;i++)
94
for(j=i+1;j<n;j++)
95
{
96
if(G[i][i] <= G[j][j])
97
{ p1 = i; p2 = j;}
98
else
99
{ p1 = j; p2 = i;}
100
if(2*abs(G[p1][p2]) == G[p1][p1])
101
{
102
s = signum(G[p1][p2]);
103
for(k=0; k<n;k++)
104
{
105
if(k != p2)
106
G[p2][k] -= s * G[p1][k];
107
if(T != NULL)
108
T[p2][k] -= s * T[p1][k];
109
}
110
for(k=0;k<n;k++)
111
{
112
G[k][p2] = G[p2][k];
113
}
114
for(k=0;k<n;k++)
115
{
116
if(k != p1 && k != p2)
117
{
118
red2 = FALSE;
119
while(red2 == FALSE && G[k][k] > 0 && G[p2][p2] > 0)
120
{
121
a = 2*abs(G[k][p2]);
122
if(a > G[k][k] || a > G[p2][p2])
123
{
124
if(a > G[k][k] && G[k][k] < G[p2][p2])
125
two_reduce(G, T, k, p2, n);
126
else
127
two_reduce(G, T, p2, k, n);
128
reduced = FALSE;
129
}
130
else
131
red2 = TRUE;
132
}
133
if(G[k][k] < 0 || G[p2][p2] < 0)
134
return;
135
}
136
}
137
}
138
if(G[i][i] < 0 || G[j][j] < 0)
139
return;
140
}
141
}
142
}
143
144
145
146
/**************************************************************************\
147
@---------------------------------------------------------------------------
148
@ matrix_TYP *pair_red(Gram, Tr)
149
@ matrix_TYP *Gram, *Tr;
150
@
151
@ calculates matrices A and Tr such that A = Tr * Gram * Tr^{tr}
152
@ is pair_reduced.
153
@ The function can be called with Tr = NULL
154
@---------------------------------------------------------------------------
155
@
156
\**************************************************************************/
157
matrix_TYP *pair_red(Gram, Tr)
158
matrix_TYP *Gram, *Tr;
159
{
160
int i,j;
161
int **G, **T;
162
matrix_TYP *Gerg;
163
164
extern matrix_TYP *copy_mat();
165
166
Gerg = copy_mat(Gram);
167
G = Gerg->array.SZ;
168
if(Tr != NULL)
169
{
170
T = Tr->array.SZ;
171
for(i=0;i<Gram->cols;i++)
172
{
173
for(j=0;j<Gram->cols;j++)
174
T[i][j] = 0;
175
T[i][i] = 1;
176
}
177
}
178
else
179
T = NULL;
180
pr_red(G, T, Gram->cols);
181
return(Gerg);
182
}
183
184