alpar@1
|
1 |
/* glpnet02.c (permutations to block triangular form) */
|
alpar@1
|
2 |
|
alpar@1
|
3 |
/***********************************************************************
|
alpar@1
|
4 |
* This code is part of GLPK (GNU Linear Programming Kit).
|
alpar@1
|
5 |
*
|
alpar@1
|
6 |
* This code is the result of translation of the Fortran subroutines
|
alpar@1
|
7 |
* MC13D and MC13E associated with the following paper:
|
alpar@1
|
8 |
*
|
alpar@1
|
9 |
* I.S.Duff, J.K.Reid, Algorithm 529: Permutations to block triangular
|
alpar@1
|
10 |
* form, ACM Trans. on Math. Softw. 4 (1978), 189-192.
|
alpar@1
|
11 |
*
|
alpar@1
|
12 |
* Use of ACM Algorithms is subject to the ACM Software Copyright and
|
alpar@1
|
13 |
* License Agreement. See <http://www.acm.org/publications/policies>.
|
alpar@1
|
14 |
*
|
alpar@1
|
15 |
* The translation was made by Andrew Makhorin <mao@gnu.org>.
|
alpar@1
|
16 |
*
|
alpar@1
|
17 |
* GLPK is free software: you can redistribute it and/or modify it
|
alpar@1
|
18 |
* under the terms of the GNU General Public License as published by
|
alpar@1
|
19 |
* the Free Software Foundation, either version 3 of the License, or
|
alpar@1
|
20 |
* (at your option) any later version.
|
alpar@1
|
21 |
*
|
alpar@1
|
22 |
* GLPK is distributed in the hope that it will be useful, but WITHOUT
|
alpar@1
|
23 |
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
alpar@1
|
24 |
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
|
alpar@1
|
25 |
* License for more details.
|
alpar@1
|
26 |
*
|
alpar@1
|
27 |
* You should have received a copy of the GNU General Public License
|
alpar@1
|
28 |
* along with GLPK. If not, see <http://www.gnu.org/licenses/>.
|
alpar@1
|
29 |
***********************************************************************/
|
alpar@1
|
30 |
|
alpar@1
|
31 |
#include "glpnet.h"
|
alpar@1
|
32 |
|
alpar@1
|
33 |
/***********************************************************************
|
alpar@1
|
34 |
* NAME
|
alpar@1
|
35 |
*
|
alpar@1
|
36 |
* mc13d - permutations to block triangular form
|
alpar@1
|
37 |
*
|
alpar@1
|
38 |
* SYNOPSIS
|
alpar@1
|
39 |
*
|
alpar@1
|
40 |
* #include "glpnet.h"
|
alpar@1
|
41 |
* int mc13d(int n, const int icn[], const int ip[], const int lenr[],
|
alpar@1
|
42 |
* int ior[], int ib[], int lowl[], int numb[], int prev[]);
|
alpar@1
|
43 |
*
|
alpar@1
|
44 |
* DESCRIPTION
|
alpar@1
|
45 |
*
|
alpar@1
|
46 |
* Given the column numbers of the nonzeros in each row of the sparse
|
alpar@1
|
47 |
* matrix, the routine mc13d finds a symmetric permutation that makes
|
alpar@1
|
48 |
* the matrix block lower triangular.
|
alpar@1
|
49 |
*
|
alpar@1
|
50 |
* INPUT PARAMETERS
|
alpar@1
|
51 |
*
|
alpar@1
|
52 |
* n order of the matrix.
|
alpar@1
|
53 |
*
|
alpar@1
|
54 |
* icn array containing the column indices of the non-zeros. Those
|
alpar@1
|
55 |
* belonging to a single row must be contiguous but the ordering
|
alpar@1
|
56 |
* of column indices within each row is unimportant and wasted
|
alpar@1
|
57 |
* space between rows is permitted.
|
alpar@1
|
58 |
*
|
alpar@1
|
59 |
* ip ip[i], i = 1,2,...,n, is the position in array icn of the
|
alpar@1
|
60 |
* first column index of a non-zero in row i.
|
alpar@1
|
61 |
*
|
alpar@1
|
62 |
* lenr lenr[i], i = 1,2,...,n, is the number of non-zeros in row i.
|
alpar@1
|
63 |
*
|
alpar@1
|
64 |
* OUTPUT PARAMETERS
|
alpar@1
|
65 |
*
|
alpar@1
|
66 |
* ior ior[i], i = 1,2,...,n, gives the position on the original
|
alpar@1
|
67 |
* ordering of the row or column which is in position i in the
|
alpar@1
|
68 |
* permuted form.
|
alpar@1
|
69 |
*
|
alpar@1
|
70 |
* ib ib[i], i = 1,2,...,num, is the row number in the permuted
|
alpar@1
|
71 |
* matrix of the beginning of block i, 1 <= num <= n.
|
alpar@1
|
72 |
*
|
alpar@1
|
73 |
* WORKING ARRAYS
|
alpar@1
|
74 |
*
|
alpar@1
|
75 |
* arp working array of length [1+n], where arp[0] is not used.
|
alpar@1
|
76 |
* arp[i] is one less than the number of unsearched edges leaving
|
alpar@1
|
77 |
* node i. At the end of the algorithm it is set to a permutation
|
alpar@1
|
78 |
* which puts the matrix in block lower triangular form.
|
alpar@1
|
79 |
*
|
alpar@1
|
80 |
* ib working array of length [1+n], where ib[0] is not used.
|
alpar@1
|
81 |
* ib[i] is the position in the ordering of the start of the ith
|
alpar@1
|
82 |
* block. ib[n+1-i] holds the node number of the ith node on the
|
alpar@1
|
83 |
* stack.
|
alpar@1
|
84 |
*
|
alpar@1
|
85 |
* lowl working array of length [1+n], where lowl[0] is not used.
|
alpar@1
|
86 |
* lowl[i] is the smallest stack position of any node to which a
|
alpar@1
|
87 |
* path from node i has been found. It is set to n+1 when node i
|
alpar@1
|
88 |
* is removed from the stack.
|
alpar@1
|
89 |
*
|
alpar@1
|
90 |
* numb working array of length [1+n], where numb[0] is not used.
|
alpar@1
|
91 |
* numb[i] is the position of node i in the stack if it is on it,
|
alpar@1
|
92 |
* is the permuted order of node i for those nodes whose final
|
alpar@1
|
93 |
* position has been found and is otherwise zero.
|
alpar@1
|
94 |
*
|
alpar@1
|
95 |
* prev working array of length [1+n], where prev[0] is not used.
|
alpar@1
|
96 |
* prev[i] is the node at the end of the path when node i was
|
alpar@1
|
97 |
* placed on the stack.
|
alpar@1
|
98 |
*
|
alpar@1
|
99 |
* RETURNS
|
alpar@1
|
100 |
*
|
alpar@1
|
101 |
* The routine mc13d returns num, the number of blocks found. */
|
alpar@1
|
102 |
|
alpar@1
|
103 |
int mc13d(int n, const int icn[], const int ip[], const int lenr[],
|
alpar@1
|
104 |
int ior[], int ib[], int lowl[], int numb[], int prev[])
|
alpar@1
|
105 |
{ int *arp = ior;
|
alpar@1
|
106 |
int dummy, i, i1, i2, icnt, ii, isn, ist, ist1, iv, iw, j, lcnt,
|
alpar@1
|
107 |
nnm1, num, stp;
|
alpar@1
|
108 |
/* icnt is the number of nodes whose positions in final ordering
|
alpar@1
|
109 |
have been found. */
|
alpar@1
|
110 |
icnt = 0;
|
alpar@1
|
111 |
/* num is the number of blocks that have been found. */
|
alpar@1
|
112 |
num = 0;
|
alpar@1
|
113 |
nnm1 = n + n - 1;
|
alpar@1
|
114 |
/* Initialization of arrays. */
|
alpar@1
|
115 |
for (j = 1; j <= n; j++)
|
alpar@1
|
116 |
{ numb[j] = 0;
|
alpar@1
|
117 |
arp[j] = lenr[j] - 1;
|
alpar@1
|
118 |
}
|
alpar@1
|
119 |
for (isn = 1; isn <= n; isn++)
|
alpar@1
|
120 |
{ /* Look for a starting node. */
|
alpar@1
|
121 |
if (numb[isn] != 0) continue;
|
alpar@1
|
122 |
iv = isn;
|
alpar@1
|
123 |
/* ist is the number of nodes on the stack ... it is the stack
|
alpar@1
|
124 |
pointer. */
|
alpar@1
|
125 |
ist = 1;
|
alpar@1
|
126 |
/* Put node iv at beginning of stack. */
|
alpar@1
|
127 |
lowl[iv] = numb[iv] = 1;
|
alpar@1
|
128 |
ib[n] = iv;
|
alpar@1
|
129 |
/* The body of this loop puts a new node on the stack or
|
alpar@1
|
130 |
backtracks. */
|
alpar@1
|
131 |
for (dummy = 1; dummy <= nnm1; dummy++)
|
alpar@1
|
132 |
{ i1 = arp[iv];
|
alpar@1
|
133 |
/* Have all edges leaving node iv been searched? */
|
alpar@1
|
134 |
if (i1 >= 0)
|
alpar@1
|
135 |
{ i2 = ip[iv] + lenr[iv] - 1;
|
alpar@1
|
136 |
i1 = i2 - i1;
|
alpar@1
|
137 |
/* Look at edges leaving node iv until one enters a new
|
alpar@1
|
138 |
node or all edges are exhausted. */
|
alpar@1
|
139 |
for (ii = i1; ii <= i2; ii++)
|
alpar@1
|
140 |
{ iw = icn[ii];
|
alpar@1
|
141 |
/* Has node iw been on stack already? */
|
alpar@1
|
142 |
if (numb[iw] == 0) goto L70;
|
alpar@1
|
143 |
/* Update value of lowl[iv] if necessary. */
|
alpar@1
|
144 |
if (lowl[iw] < lowl[iv]) lowl[iv] = lowl[iw];
|
alpar@1
|
145 |
}
|
alpar@1
|
146 |
/* There are no more edges leaving node iv. */
|
alpar@1
|
147 |
arp[iv] = -1;
|
alpar@1
|
148 |
}
|
alpar@1
|
149 |
/* Is node iv the root of a block? */
|
alpar@1
|
150 |
if (lowl[iv] < numb[iv]) goto L60;
|
alpar@1
|
151 |
/* Order nodes in a block. */
|
alpar@1
|
152 |
num++;
|
alpar@1
|
153 |
ist1 = n + 1 - ist;
|
alpar@1
|
154 |
lcnt = icnt + 1;
|
alpar@1
|
155 |
/* Peel block off the top of the stack starting at the top
|
alpar@1
|
156 |
and working down to the root of the block. */
|
alpar@1
|
157 |
for (stp = ist1; stp <= n; stp++)
|
alpar@1
|
158 |
{ iw = ib[stp];
|
alpar@1
|
159 |
lowl[iw] = n + 1;
|
alpar@1
|
160 |
numb[iw] = ++icnt;
|
alpar@1
|
161 |
if (iw == iv) break;
|
alpar@1
|
162 |
}
|
alpar@1
|
163 |
ist = n - stp;
|
alpar@1
|
164 |
ib[num] = lcnt;
|
alpar@1
|
165 |
/* Are there any nodes left on the stack? */
|
alpar@1
|
166 |
if (ist != 0) goto L60;
|
alpar@1
|
167 |
/* Have all the nodes been ordered? */
|
alpar@1
|
168 |
if (icnt < n) break;
|
alpar@1
|
169 |
goto L100;
|
alpar@1
|
170 |
L60: /* Backtrack to previous node on path. */
|
alpar@1
|
171 |
iw = iv;
|
alpar@1
|
172 |
iv = prev[iv];
|
alpar@1
|
173 |
/* Update value of lowl[iv] if necessary. */
|
alpar@1
|
174 |
if (lowl[iw] < lowl[iv]) lowl[iv] = lowl[iw];
|
alpar@1
|
175 |
continue;
|
alpar@1
|
176 |
L70: /* Put new node on the stack. */
|
alpar@1
|
177 |
arp[iv] = i2 - ii - 1;
|
alpar@1
|
178 |
prev[iw] = iv;
|
alpar@1
|
179 |
iv = iw;
|
alpar@1
|
180 |
lowl[iv] = numb[iv] = ++ist;
|
alpar@1
|
181 |
ib[n+1-ist] = iv;
|
alpar@1
|
182 |
}
|
alpar@1
|
183 |
}
|
alpar@1
|
184 |
L100: /* Put permutation in the required form. */
|
alpar@1
|
185 |
for (i = 1; i <= n; i++)
|
alpar@1
|
186 |
arp[numb[i]] = i;
|
alpar@1
|
187 |
return num;
|
alpar@1
|
188 |
}
|
alpar@1
|
189 |
|
alpar@1
|
190 |
/**********************************************************************/
|
alpar@1
|
191 |
|
alpar@1
|
192 |
#if 0
|
alpar@1
|
193 |
#include "glplib.h"
|
alpar@1
|
194 |
|
alpar@1
|
195 |
void test(int n, int ipp);
|
alpar@1
|
196 |
|
alpar@1
|
197 |
int main(void)
|
alpar@1
|
198 |
{ /* test program for routine mc13d */
|
alpar@1
|
199 |
test( 1, 0);
|
alpar@1
|
200 |
test( 2, 1);
|
alpar@1
|
201 |
test( 2, 2);
|
alpar@1
|
202 |
test( 3, 3);
|
alpar@1
|
203 |
test( 4, 4);
|
alpar@1
|
204 |
test( 5, 10);
|
alpar@1
|
205 |
test(10, 10);
|
alpar@1
|
206 |
test(10, 20);
|
alpar@1
|
207 |
test(20, 20);
|
alpar@1
|
208 |
test(20, 50);
|
alpar@1
|
209 |
test(50, 50);
|
alpar@1
|
210 |
test(50, 200);
|
alpar@1
|
211 |
return 0;
|
alpar@1
|
212 |
}
|
alpar@1
|
213 |
|
alpar@1
|
214 |
void fa01bs(int max, int *nrand);
|
alpar@1
|
215 |
|
alpar@1
|
216 |
void setup(int n, char a[1+50][1+50], int ip[], int icn[], int lenr[]);
|
alpar@1
|
217 |
|
alpar@1
|
218 |
void test(int n, int ipp)
|
alpar@1
|
219 |
{ int ip[1+50], icn[1+1000], ior[1+50], ib[1+51], iw[1+150],
|
alpar@1
|
220 |
lenr[1+50];
|
alpar@1
|
221 |
char a[1+50][1+50], hold[1+100];
|
alpar@1
|
222 |
int i, ii, iblock, ij, index, j, jblock, jj, k9, num;
|
alpar@1
|
223 |
xprintf("\n\n\nMatrix is of order %d and has %d off-diagonal non-"
|
alpar@1
|
224 |
"zeros\n", n, ipp);
|
alpar@1
|
225 |
for (j = 1; j <= n; j++)
|
alpar@1
|
226 |
{ for (i = 1; i <= n; i++)
|
alpar@1
|
227 |
a[i][j] = 0;
|
alpar@1
|
228 |
a[j][j] = 1;
|
alpar@1
|
229 |
}
|
alpar@1
|
230 |
for (k9 = 1; k9 <= ipp; k9++)
|
alpar@1
|
231 |
{ /* these statements should be replaced by calls to your
|
alpar@1
|
232 |
favorite random number generator to place two pseudo-random
|
alpar@1
|
233 |
numbers between 1 and n in the variables i and j */
|
alpar@1
|
234 |
for (;;)
|
alpar@1
|
235 |
{ fa01bs(n, &i);
|
alpar@1
|
236 |
fa01bs(n, &j);
|
alpar@1
|
237 |
if (!a[i][j]) break;
|
alpar@1
|
238 |
}
|
alpar@1
|
239 |
a[i][j] = 1;
|
alpar@1
|
240 |
}
|
alpar@1
|
241 |
/* setup converts matrix a[i,j] to required sparsity-oriented
|
alpar@1
|
242 |
storage format */
|
alpar@1
|
243 |
setup(n, a, ip, icn, lenr);
|
alpar@1
|
244 |
num = mc13d(n, icn, ip, lenr, ior, ib, &iw[0], &iw[n], &iw[n+n]);
|
alpar@1
|
245 |
/* output reordered matrix with blocking to improve clarity */
|
alpar@1
|
246 |
xprintf("\nThe reordered matrix which has %d block%s is of the fo"
|
alpar@1
|
247 |
"rm\n", num, num == 1 ? "" : "s");
|
alpar@1
|
248 |
ib[num+1] = n + 1;
|
alpar@1
|
249 |
index = 100;
|
alpar@1
|
250 |
iblock = 1;
|
alpar@1
|
251 |
for (i = 1; i <= n; i++)
|
alpar@1
|
252 |
{ for (ij = 1; ij <= index; ij++)
|
alpar@1
|
253 |
hold[ij] = ' ';
|
alpar@1
|
254 |
if (i == ib[iblock])
|
alpar@1
|
255 |
{ xprintf("\n");
|
alpar@1
|
256 |
iblock++;
|
alpar@1
|
257 |
}
|
alpar@1
|
258 |
jblock = 1;
|
alpar@1
|
259 |
index = 0;
|
alpar@1
|
260 |
for (j = 1; j <= n; j++)
|
alpar@1
|
261 |
{ if (j == ib[jblock])
|
alpar@1
|
262 |
{ hold[++index] = ' ';
|
alpar@1
|
263 |
jblock++;
|
alpar@1
|
264 |
}
|
alpar@1
|
265 |
ii = ior[i];
|
alpar@1
|
266 |
jj = ior[j];
|
alpar@1
|
267 |
hold[++index] = (char)(a[ii][jj] ? 'X' : '0');
|
alpar@1
|
268 |
}
|
alpar@1
|
269 |
xprintf("%.*s\n", index, &hold[1]);
|
alpar@1
|
270 |
}
|
alpar@1
|
271 |
xprintf("\nThe starting point for each block is given by\n");
|
alpar@1
|
272 |
for (i = 1; i <= num; i++)
|
alpar@1
|
273 |
{ if ((i - 1) % 12 == 0) xprintf("\n");
|
alpar@1
|
274 |
xprintf(" %4d", ib[i]);
|
alpar@1
|
275 |
}
|
alpar@1
|
276 |
xprintf("\n");
|
alpar@1
|
277 |
return;
|
alpar@1
|
278 |
}
|
alpar@1
|
279 |
|
alpar@1
|
280 |
void setup(int n, char a[1+50][1+50], int ip[], int icn[], int lenr[])
|
alpar@1
|
281 |
{ int i, j, ind;
|
alpar@1
|
282 |
for (i = 1; i <= n; i++)
|
alpar@1
|
283 |
lenr[i] = 0;
|
alpar@1
|
284 |
ind = 1;
|
alpar@1
|
285 |
for (i = 1; i <= n; i++)
|
alpar@1
|
286 |
{ ip[i] = ind;
|
alpar@1
|
287 |
for (j = 1; j <= n; j++)
|
alpar@1
|
288 |
{ if (a[i][j])
|
alpar@1
|
289 |
{ lenr[i]++;
|
alpar@1
|
290 |
icn[ind++] = j;
|
alpar@1
|
291 |
}
|
alpar@1
|
292 |
}
|
alpar@1
|
293 |
}
|
alpar@1
|
294 |
return;
|
alpar@1
|
295 |
}
|
alpar@1
|
296 |
|
alpar@1
|
297 |
double g = 1431655765.0;
|
alpar@1
|
298 |
|
alpar@1
|
299 |
double fa01as(int i)
|
alpar@1
|
300 |
{ /* random number generator */
|
alpar@1
|
301 |
g = fmod(g * 9228907.0, 4294967296.0);
|
alpar@1
|
302 |
if (i >= 0)
|
alpar@1
|
303 |
return g / 4294967296.0;
|
alpar@1
|
304 |
else
|
alpar@1
|
305 |
return 2.0 * g / 4294967296.0 - 1.0;
|
alpar@1
|
306 |
}
|
alpar@1
|
307 |
|
alpar@1
|
308 |
void fa01bs(int max, int *nrand)
|
alpar@1
|
309 |
{ *nrand = (int)(fa01as(1) * (double)max) + 1;
|
alpar@1
|
310 |
return;
|
alpar@1
|
311 |
}
|
alpar@1
|
312 |
#endif
|
alpar@1
|
313 |
|
alpar@1
|
314 |
/* eof */
|