/* find the strongly connected components of a square matrix */
csd *cs_scc (cs *A) /* matrix A temporarily modified, then restored */
{
int n, i, k, b, nb = 0, top, *xi, *pstack, *p, *r, *Ap, *ATp, *rcopy, *Blk ;
cs *AT ;
csd *D ;
if (!CS_CSC (A)) return (NULL) ; /* check inputs */
n = A->n ; Ap = A->p ;
D = cs_dalloc (n, 0) ; /* allocate result */
AT = cs_transpose (A, 0) ; /* AT = A' */
xi = cs_malloc (2*n+1, sizeof (int)) ; /* get workspace */
if (!D || !AT || !xi) return (cs_ddone (D, AT, xi, 0)) ;
Blk = xi ; rcopy = pstack = xi + n ;
p = D->p ; r = D->r ; ATp = AT->p ;
top = n ;
for (i = 0 ; i < n ; i++) /* first dfs(A) to find finish times (xi) */
{
if (!CS_MARKED (Ap, i)) top = cs_dfs (i, A, top, xi, pstack, NULL) ;
}
for (i = 0 ; i < n ; i++) CS_MARK (Ap, i) ; /* restore A; unmark all nodes*/
top = n ;
nb = n ;
for (k = 0 ; k < n ; k++) /* dfs(A') to find strongly connnected comp */
{
i = xi [k] ; /* get i in reverse order of finish times */
if (CS_MARKED (ATp, i)) continue ; /* skip node i if already ordered */
r [nb--] = top ; /* node i is the start of a component in p */
top = cs_dfs (i, AT, top, p, pstack, NULL) ;
}
r [nb] = 0 ; /* first block starts at zero; shift r up */
for (k = nb ; k <= n ; k++) r [k-nb] = r [k] ;
D->nb = nb = n-nb ; /* nb = # of strongly connected components */
for (b = 0 ; b < nb ; b++) /* sort each block in natural order */
{
for (k = r [b] ; k < r [b+1] ; k++) Blk [p [k]] = b ;
}
for (b = 0 ; b <= nb ; b++) rcopy [b] = r [b] ;
for (i = 0 ; i < n ; i++) p [rcopy [Blk [i]]++] = i ;
return (cs_ddone (D, AT, xi, 1)) ;
}
/* Given A, compute coarse and then fine dmperm */
csd *cs_dmperm (const cs *A, int seed)
{
int m, n, i, j, k, cnz, nc, *jmatch, *imatch, *wi, *wj, *pinv, *Cp, *Ci,
*ps, *rs, nb1, nb2, *p, *q, *cc, *rr, *r, *s, ok ;
cs *C ;
csd *D, *scc ;
/* --- Maximum matching ------------------------------------------------- */
if (!CS_CSC (A)) return (NULL) ; /* check inputs */
m = A->m ; n = A->n ;
D = cs_dalloc (m, n) ; /* allocate result */
if (!D) return (NULL) ;
p = D->p ; q = D->q ; r = D->r ; s = D->s ; cc = D->cc ; rr = D->rr ;
jmatch = cs_maxtrans (A, seed) ; /* max transversal */
imatch = jmatch + m ; /* imatch = inverse of jmatch */
if (!jmatch) return (cs_ddone (D, NULL, jmatch, 0)) ;
/* --- Coarse decomposition --------------------------------------------- */
wi = r ; wj = s ; /* use r and s as workspace */
for (j = 0 ; j < n ; j++) wj [j] = -1 ; /* unmark all cols for bfs */
for (i = 0 ; i < m ; i++) wi [i] = -1 ; /* unmark all rows for bfs */
cs_bfs (A, n, wi, wj, q, imatch, jmatch, 1) ; /* find C1, R1 from C0*/
ok = cs_bfs (A, m, wj, wi, p, jmatch, imatch, 3) ; /* find R3, C3 from R0*/
if (!ok) return (cs_ddone (D, NULL, jmatch, 0)) ;
cs_unmatched (n, wj, q, cc, 0) ; /* unmatched set C0 */
cs_matched (n, wj, imatch, p, q, cc, rr, 1, 1) ; /* set R1 and C1 */
cs_matched (n, wj, imatch, p, q, cc, rr, 2, -1) ; /* set R2 and C2 */
cs_matched (n, wj, imatch, p, q, cc, rr, 3, 3) ; /* set R3 and C3 */
cs_unmatched (m, wi, p, rr, 3) ; /* unmatched set R0 */
cs_free (jmatch) ;
/* --- Fine decomposition ----------------------------------------------- */
pinv = cs_pinv (p, m) ; /* pinv=p' */
if (!pinv) return (cs_ddone (D, NULL, NULL, 0)) ;
C = cs_permute (A, pinv, q, 0) ;/* C=A(p,q) (it will hold A(R2,C2)) */
cs_free (pinv) ;
if (!C) return (cs_ddone (D, NULL, NULL, 0)) ;
Cp = C->p ;
nc = cc [3] - cc [2] ; /* delete cols C0, C1, and C3 from C */
if (cc [2] > 0) for (j = cc [2] ; j <= cc [3] ; j++) Cp [j-cc[2]] = Cp [j] ;
C->n = nc ;
if (rr [2] - rr [1] < m) /* delete rows R0, R1, and R3 from C */
{
cs_fkeep (C, cs_rprune, rr) ;
cnz = Cp [nc] ;
Ci = C->i ;
if (rr [1] > 0) for (k = 0 ; k < cnz ; k++) Ci [k] -= rr [1] ;
}
C->m = nc ;
scc = cs_scc (C) ; /* find strongly connected components of C*/
if (!scc) return (cs_ddone (D, C, NULL, 0)) ;
/* --- Combine coarse and fine decompositions --------------------------- */
ps = scc->p ; /* C(ps,ps) is the permuted matrix */
rs = scc->r ; /* kth block is rs[k]..rs[k+1]-1 */
nb1 = scc->nb ; /* # of blocks of A(R2,C2) */
for (k = 0 ; k < nc ; k++) wj [k] = q [ps [k] + cc [2]] ;
for (k = 0 ; k < nc ; k++) q [k + cc [2]] = wj [k] ;
for (k = 0 ; k < nc ; k++) wi [k] = p [ps [k] + rr [1]] ;
for (k = 0 ; k < nc ; k++) p [k + rr [1]] = wi [k] ;
nb2 = 0 ; /* create the fine block partitions */
r [0] = s [0] = 0 ;
if (cc [2] > 0) nb2++ ; /* leading coarse block A (R1, [C0 C1]) */
for (k = 0 ; k < nb1 ; k++) /* coarse block A (R2,C2) */
{
r [nb2] = rs [k] + rr [1] ; /* A (R2,C2) splits into nb1 fine blocks */
s [nb2] = rs [k] + cc [2] ;
nb2++ ;
}
if (rr [2] < m)
{
r [nb2] = rr [2] ; /* trailing coarse block A ([R3 R0], C3) */
s [nb2] = cc [3] ;
nb2++ ;
}
r [nb2] = m ;
s [nb2] = n ;
D->nb = nb2 ;
cs_dfree (scc) ;
return (cs_ddone (D, C, NULL, 1)) ;
}
