static mclv* get_closure
( mclx* mx /* caller must have invoked mclgUnionvReset before */
, const mclv* nbls
)
{ mclv* nbls_closure = mclvCopy(NULL, nbls), *wave1 = mclvCopy(NULL, nbls_closure), *wave2 = NULL
;
mclgUnionvInitList(mx, nbls_closure)
;
while (wave1->n_ivps)
{ wave2 = mclgUnionv(mx, wave1, NULL, SCRATCH_UPDATE, NULL)
;
mcldMerge(nbls_closure, wave2, nbls_closure)
;
mclvFree(&wave1)
;
wave1 = wave2
;
}
mclgUnionvResetList(mx, nbls_closure)
;
mclvFree(&wave1)
;
return nbls_closure
;
}
mclMatrix* mclDag
( const mclMatrix* A
, const mclInterpretParam* ipp
)
{ dim d
;
double w_selfval= ipp ? ipp->w_selfval: 0.999
;
double w_maxval = ipp ? ipp->w_maxval : 0.001
;
double delta = ipp ? ipp->delta : 0.01
;
mclMatrix* M = mclxAllocZero
( mclvCopy(NULL, A->dom_cols)
, mclvCopy(NULL, A->dom_rows)
)
;
for (d=0; d<N_COLS(A); d++) /* thorough clean-up */
{ mclVector* vec = A->cols+d
;
mclVector* dst = M->cols+d
;
double selfval = mclvIdxVal(vec, vec->vid, NULL)
;
double maxval = mclvMaxValue(vec)
;
double bar = selfval < maxval
? ( (w_selfval * selfval)
+ (w_maxval * maxval)
)
: delta
? selfval / (1 + delta)
: selfval
;
int n_bar = mclvCountGiven(vec, mclpGivenValGQ, &bar)
;
mclvCopyGiven(dst, vec, mclpGivenValGQ, &bar, n_bar)
;
}
if (0)
{ dim ne = mclxNrofEntries(M)
;
fprintf(stderr, "nroff entries %u\n", (unsigned) ne)
;
}
return M
;
}
mclVector* mclvMap
( mclVector* dst
, long mul
, long shift
, mclVector* src
)
{ mclIvp* ivp, *ivpmax
/* fixme: add error checking, overflow, sign */
; if (!dst)
dst = mclvCopy(NULL, src)
; else if (src != dst)
mclvInstantiate(dst, src->n_ivps, src->ivps)
; ivp = dst->ivps
; ivpmax = ivp + dst->n_ivps
; while (ivp < ivpmax)
{ ivp->idx = mul*ivp->idx + shift
; ivp++
; }
return dst
; }
int mclDagTest
( const mclMatrix* dag
)
{ mclv* v_transient = mclvCopy(NULL, dag->dom_cols)
; mclx* m_transient = NULL
; int maxdepth = 0
; dim d
; mclvMakeCharacteristic(v_transient)
; for (d=0;d<N_COLS(dag);d++)
{ mclv* col = dag->cols+d
; if (mclvGetIvp(col, col->vid, NULL)) /* deemed attractor */
mclvInsertIdx(v_transient, col->vid, 0.25)
; }
mclvSelectGqBar(v_transient, 0.5)
; m_transient = mclxSub(dag, v_transient, v_transient)
;if(0)mclxDebug("-", m_transient, 3, "transient")
; maxdepth = calc_depth(m_transient)
; mclxFree(&m_transient)
; mclvFree(&v_transient)
; return maxdepth
; }
mcxstatus fire_node_next
( const mclx* mx
, mclv* seen
, mclv *todo
, dim start
)
{ mclv* next = mclvInit(NULL)
; dim i
; mcxstatus s = STATUS_OK
;if(0)fprintf(stderr, "\tnext layer has %d nodes\n", (int) todo->n_ivps)
; for (i=0; i<todo->n_ivps;i++)
{ mclv* ls = mclxGetVector(mx, todo->ivps[i].idx, RETURN_ON_FAIL, NULL)
; if (ls)
{ mcldMerge(next, ls, next)
; if (mclvGetIvp(ls, start, NULL))
{ s = STATUS_FAIL
; break
; }
}
}
mcldMerge(seen, todo, seen) /* add todo to seen */
; mcldMinus(next, seen, next) /* remove seen from next */
; mclvCopy(todo, next) /* copy next to todo */
; mclvFree(&next)
; return s
; }
mclMatrix* mclInterpret
( mclMatrix* dag
)
{ mclv* v_attr = mclvCopy(NULL, dag->dom_cols)
; mclx* m_attr = NULL, *m_cls = NULL, *m_clst = NULL
; dim d
; mclvMakeCharacteristic(v_attr)
; for (d=0;d<N_COLS(dag);d++)
{ mclv* col = dag->cols+d
; if (mclvGetIvp(col, col->vid, NULL)) /* deemed attractor */
mclvInsertIdx(v_attr, col->vid, 2.0)
; }
mclvSelectGqBar(v_attr, 1.5)
; m_attr = mclxSub(dag, v_attr, v_attr)
; mclxAddTranspose(m_attr, 1.0)
; m_cls = clmUGraphComponents(m_attr, NULL) /* attractor systems as clusters */
; mclvCopy(m_cls->dom_rows, dag->dom_cols) /* add all nodes to this cluster matrix */
; m_clst = mclxTranspose(m_cls) /* nodes(columns) with zero neighbours need to be classified */
; mclgUnionvReset(dag) /* make mx->dom-rows characteristic */
; mclxFree(&m_cls)
; for (d=0;d<N_COLS(dag);d++)
{ mclv* closure, *clsids
; if (mclvGetIvp(v_attr, dag->cols[d].vid, NULL))
continue /* attractor already classified */
; closure = get_closure(dag, dag->cols+d) /* take all [neighbours of [neighbours of [..]]] */
; clsids = mclgUnionv(m_clst, closure, NULL, SCRATCH_READY, NULL)
; mclvAdd(m_clst->cols+d, clsids, m_clst->cols+d)
; mclvFree(&clsids)
; mclvFree(&closure)
; }
m_cls = mclxTranspose(m_clst)
; mclxFree(&m_attr)
; mclxFree(&m_clst)
; mclvFree(&v_attr)
; return m_cls
; }
/* this code is hilarious hiledeous ..
* but it is an honest attempt at optimizing different scenarios.
*/
mclVector* mcldMeet2
( const mclVector* lft
, const mclVector* rgt
, mclVector* dst
)
{ if (lft == rgt)
return dst == lft ? dst : mclvCopy(dst, lft)
; if
( dst != lft
&& ( nu_magic * log(lft->n_ivps+1) * rgt->n_ivps < lft->n_ivps /* this means rgt is small */
|| dst == rgt
)
)
{ if (dst != rgt) /* now (small) dst has only rgt values (and lft != rgt) */
dst = mclvCopy(dst, rgt)
; if (mclvUpdateDiff(dst, lft, flt0p0)) /* rgt meet values remain */
mclvUnary(dst, fltxCopy, NULL)
; mclvUpdateMeet(dst, lft, fltRight) /* set them to left again */
; }
/* dst == lft
* or ( size comparison ok
* and dst != rgt
* )
*/
else
{ if (dst == lft)
NOTHING
; else /* dst != rgt */
dst = mclvCopy(dst, lft)
; if (mclvUpdateDiff(dst, rgt, flt0p0))
mclvUnary(dst, fltxCopy, NULL)
; }
return dst
; }
mclVector* mcldMinus
( const mclVector* lft
, const mclVector* rgt
, mclVector* dst
)
{ if (rgt == dst) /* interesting src/dst pattern */
return mclvBinary(lft, rgt, dst, fltLaNR)
; else
{ if (lft != dst)
dst = mclvCopy(dst, lft)
/* if lft is large and rgt as well then copying may introduce
* unnecessary work. But we don't really have a way of knowing in
* advance, and the solution would probably involve headaches
* similar to the ones in mcldMeet.
*/
; if (mclvUpdateMeet(dst, rgt, flt0p0))
mclvUnary(dst, fltxCopy, NULL)
; }
return dst
; }
mclVector* mclvClone
( const mclVector* src
)
{ return mclvCopy(NULL, src)
; }
int main
( int argc
, const char* argv[]
)
{ mcxIO *xfin = mcxIOnew("-", "r")
; mcxIO *xfout = mcxIOnew("-", "w")
; mclMatrix *mx = NULL
; mclx* cmapx = NULL, *rmapx = NULL
; const char* me = "mcxmap"
; long cshift = 0
; long rshift = 0
; long cmul = 1
; long rmul = 1
; mcxIO* xf_cannc = NULL
; mcxIO* xf_cannr = NULL
; mcxstatus status = STATUS_OK
; mcxbool invert = FALSE
; mcxbool invertr = FALSE
; mcxbool invertc = FALSE
; mcxIO* xf_map_c = NULL, *xf_map_r = NULL, *xf_map = NULL, *xf_tab = NULL
; mcxOption* opts, *opt
; mcxstatus parseStatus = STATUS_OK
; mcxLogLevel =
MCX_LOG_AGGR | MCX_LOG_MODULE | MCX_LOG_IO | MCX_LOG_GAUGE | MCX_LOG_WARN
; mclxIOsetQMode("MCLXIOVERBOSITY", MCL_APP_VB_NO)
; mclx_app_init(stderr)
; mcxOptAnchorSortById(options, sizeof(options)/sizeof(mcxOptAnchor) -1)
; opts = mcxOptParse(options, (char**) argv, argc, 1, 0, &parseStatus)
; if (!opts)
exit(0)
; for (opt=opts;opt->anch;opt++)
{ mcxOptAnchor* anch = opt->anch
; switch(anch->id)
{ case MY_OPT_HELP
: case MY_OPT_APROPOS
: mcxOptApropos(stdout, me, syntax, 0, 0, options)
; return 0
;
case MY_OPT_VERSION
: app_report_version(me)
; return 0
;
case MY_OPT_IMX
: mcxIOnewName(xfin, opt->val)
; break
;
case MY_OPT_OUT
: mcxIOnewName(xfout, opt->val)
; break
;
case MY_OPT_MUL
: cmul = atol(opt->val)
; rmul = cmul
; break
;
case MY_OPT_CMUL
: cmul = atol(opt->val)
; break
;
case MY_OPT_RMUL
: rmul = atol(opt->val)
; break
;
case MY_OPT_SHIFT
: cshift = atol(opt->val)
; rshift = atol(opt->val)
; break
;
case MY_OPT_CSHIFT
: cshift = atol(opt->val)
; break
;
case MY_OPT_RSHIFT
: rshift = atol(opt->val)
; break
;
case MY_OPT_MAP
: xf_map = mcxIOnew(opt->val, "r")
; invert = FALSE
; break
;
case MY_OPT_CMAP
: invertc = FALSE
; xf_map_c = mcxIOnew(opt->val, "r")
; break
;
case MY_OPT_RMAP
: invertr = FALSE
; xf_map_r = mcxIOnew(opt->val, "r")
; break
;
case MY_OPT_MAPI
: invert = TRUE
; xf_map = mcxIOnew(opt->val, "r")
; break
;
case MY_OPT_CMAPI
: invertc = TRUE
; xf_map_c = mcxIOnew(opt->val, "r")
; break
;
case MY_OPT_RMAPI
: invertr = TRUE
; xf_map_r = mcxIOnew(opt->val, "r")
; break
;
case MY_OPT_MAKE_MAP
: xf_cannc = mcxIOnew(opt->val, "w")
; xf_cannr = xf_cannc
; break
;
case MY_OPT_MAKE_MAPC
: xf_cannc = mcxIOnew(opt->val, "w")
; break
;
case MY_OPT_MAKE_MAPR
: xf_cannr = mcxIOnew(opt->val, "w")
; break
;
case MY_OPT_TAB
: xf_tab = mcxIOnew(opt->val, "r")
; break
;
}
}
/* little special case. restructure when it grows */
if (xf_tab)
{ mclTab* tab1, *tab2
; if (xf_map)
{ mcxIOopen(xf_map, EXIT_ON_FAIL)
; cmapx = mclxRead(xf_map, EXIT_ON_FAIL)
; }
else
mcxDie(1, me, "-tab option requires -map option")
; tab1 = mclTabRead(xf_tab, NULL, EXIT_ON_FAIL)
; if ((tab2 = mclTabMap(tab1, cmapx)))
mclTabWrite(tab2, xfout, NULL, EXIT_ON_FAIL)
; else
mcxDie(1, me, "map file error (subsumption/bijection)")
; return 0
; }
mx = mclxRead(xfin, EXIT_ON_FAIL)
; if (xf_map)
{ mcxIOopen(xf_map, EXIT_ON_FAIL)
; cmapx = mclxRead(xf_map, EXIT_ON_FAIL)
; rmapx = cmapx
; }
else
{ if (xf_map_c)
{ mcxIOopen(xf_map_c, EXIT_ON_FAIL)
; cmapx = mclxRead(xf_map_c, EXIT_ON_FAIL)
; }
else if (cshift || cmul > 1)
cmapx
= mclxMakeMap
( mclvCopy(NULL, mx->dom_cols)
, mclvMap(NULL, cmul, cshift, mx->dom_cols)
)
; else if (xf_cannc) /* fixme slightly flaky interface */
{ cmapx
= mclxMakeMap
( mclvCopy(NULL, mx->dom_cols)
, mclvCanonical(NULL, mx->dom_cols->n_ivps, 1.0)
)
; mclxWrite(cmapx, xf_cannc, MCLXIO_VALUE_GETENV, RETURN_ON_FAIL)
; }
if (xf_map_r)
{ mcxIOopen(xf_map_r, EXIT_ON_FAIL)
; rmapx = mclxRead(xf_map_r, EXIT_ON_FAIL)
; }
else if (rshift || rmul > 1)
rmapx
= mclxMakeMap
( mclvCopy(NULL, mx->dom_rows)
, mclvMap(NULL, rmul, rshift, mx->dom_rows)
)
; else if (xf_cannr)
{ rmapx
= mclxMakeMap
( mclvCopy(NULL, mx->dom_rows)
, mclvCanonical(NULL, mx->dom_rows->n_ivps, 1.0)
)
; if (xf_cannr != xf_cannc)
mclxWrite(rmapx, xf_cannr, MCLXIO_VALUE_GETENV, RETURN_ON_FAIL)
; else if (!mclxIsGraph(mx))
mcxErr(me, "row map not written but matrix is not a graph")
; }
}
if (invert && cmapx && cmapx == rmapx)
{ mclx* cmapxi = mclxTranspose(cmapx)
; mclxFree(&cmapx)
; cmapx = rmapx = cmapxi
; }
else
{ if ((invert || invertr) && rmapx)
{ mclx* rmapxi = mclxTranspose(rmapx)
; mclxFree(&rmapx)
; rmapx = rmapxi
; }
if ((invert || invertc) && cmapx)
{ mclx* cmapxi = mclxTranspose(cmapx)
; mclxFree(&cmapx)
; cmapx = cmapxi
; }
}
; status = STATUS_FAIL
; do
{ if (cmapx && mclxMapCols(mx, cmapx))
break
; if (rmapx && mclxMapRows(mx, rmapx))
break
; status = STATUS_OK
; }
while (0)
; if (status)
{ mcxErr(me, "error, nothing written")
; return 1
; }
mclxWrite(mx, xfout, MCLXIO_VALUE_GETENV, EXIT_ON_FAIL)
; return 0
; }
void pairwise_setops
( mclx* mx1
, mclx* mx2
, mcxbits modes
)
{ dim t, u, n_tst = 0
; mclv* cache = mclvInit(NULL)
; mclv* meet = mclvInit(NULL)
; mclv* join = mclvInit(NULL)
; mclv* diff = mclvInit(NULL)
; mcxbool overwrite = modes & MMM_OVERWRITE
; dim n_zero_meet = 0, n_plus_meet = 0
; mclv* (*fn_meet)(const mclv* lft, const mclv* rgt, mclv* dst) = mcldMeet
; mclv* (*fn_minus)(const mclv* lft, const mclv* rgt, mclv* dst) = mcldMinus1
; if (modes & MMM_MEET2)
fn_meet = mcldMeet2
, fn_minus = mcldMinus
/* the point of overwrite is to have
* a lft == dst or rgt == dst pattern.
*/
; for (t=0;t<N_COLS(mx1);t++)
{ for (u=0;u<N_COLS(mx2);u++)
{ mclv* dst = overwrite ? (modes & MMM_RIGHT ? mx1->cols+u : mx2->cols+t) : diff
; if (overwrite)
mclvCopy(cache, dst) /* cache column, reinstate later */
; if (modes & MMM_BINARY)
mclvBinary(mx1->cols+t, mx2->cols+u, dst, fltLaNR)
; else
fn_minus(mx1->cols+t, mx2->cols+u, dst) /* compute t / u */
; if (overwrite)
mclvCopy(diff, dst)
, mclvCopy(dst, cache) /* reinstate column */
/* diff contains t / u */
; dst = overwrite ? dst : meet /* cache column, same as above */
; if (modes & MMM_BINARY)
mclvBinary(mx1->cols+t, mx2->cols+u, dst, fltLaR)
; else
fn_meet(mx1->cols+t, mx2->cols+u, dst)
; if (overwrite)
mclvCopy(meet, dst)
, mclvCopy(dst, cache) /* meet contains t /\ u */
; mcldMerge(diff, meet, join) /* join should be identical to column t */
; if (meet->n_ivps)
n_plus_meet++
; else
n_zero_meet++
; if (modes & MMM_CHECK)
{ mclv* dediff = mclvClone(mx1->cols+t)
; mclv* demeet = mclvClone(mx1->cols+t)
; dim nd = mclvUpdateMeet(dediff, diff, fltSubtract)
; dim nm = mclvUpdateMeet(demeet, meet, fltSubtract)
; if
( diff->n_ivps + meet->n_ivps != mx1->cols[t].n_ivps
|| !mcldEquate(join, mx1->cols+t, MCLD_EQT_EQUAL)
|| diff->n_ivps != nd
|| meet->n_ivps != nm
)
{ mclvaDump(mx1->cols+t, stdout, -1, " ", MCLVA_DUMP_HEADER_ON)
; mclvaDump(mx2->cols+u, stdout, -1, " ", MCLVA_DUMP_HEADER_ON)
; mclvaDump(meet, stdout, -1, " ", MCLVA_DUMP_HEADER_ON)
; mclvaDump(diff, stdout, -1, " ", MCLVA_DUMP_HEADER_ON)
; mcxDie(1, me, "rats")
; }
mclvFree(&dediff)
; mclvFree(&demeet)
; }
n_tst++
; }
}
fprintf
( stdout
, "meet was nonempty %.2f\n"
, (double) (n_plus_meet * 1.0f / n_tst)
)
; fprintf
( stdout
, "%d successful tests in %s%s %s mode (checked: %s)\n"
, (int) n_tst
, overwrite ? "overwrite" : "create"
, overwrite ? ( modes & MMM_RIGHT ? "-right" : "-left" ) : ""
, modes & MMM_BINARY
? "generic"
: "update"
, (modes & MMM_CHECK ? "yes" : "no")
)
; fprintf
( stdout
, "meet-can: %10lu\n"
"meet-zip: %10lu\n"
"meet-s/l: %10lu\n"
"diff-can: %10lu\n"
"diff-zip: %10lu\n"
"diff-s/l: %10lu\n"
, (ulong) nu_meet_can
, (ulong) nu_meet_zip
, (ulong) nu_meet_sl
, (ulong) nu_diff_can
, (ulong) nu_diff_zip
, (ulong) nu_diff_sl
)
; mclvFree(&cache)
; mclvFree(&meet)
; mclvFree(&join)
; mclvFree(&diff)
; }
; dim i, n_thread_g
; progress_g = mcx_progress_g
; debug_g = mcx_debug_g
; n_thread_g = mclx_set_threads_or_die(mediam, n_thread_l, i_group, n_group_G)
;fprintf(stderr, "%d %d %d\n", (int) n_thread_g, (int) n_thread_l, (int) n_group_G)
; mcxIOopen(xfout, EXIT_ON_FAIL)
; mx = mcx_get_network(xfmx_g, xfabc_g, xftab_g, &tab_g)
; mcxIOfree(&xfmx_g)
; mclxAdjustLoops(mx, mclxLoopCBremove, NULL)
; tabulator = calloc(N_COLS(mx), sizeof tabulator[0])
; ecc_scratch = mclvCopy(NULL, mx->dom_rows)
/* ^ used as ecc scratch: should have values 1.0 */
; canonical = MCLV_IS_CANONICAL(mx->dom_cols)
; if (rough && !mclxGraphCanonical(mx))
mcxDie(1, mediam, "rough needs canonical domains")
; if (rough)
{ u8* rough_scratch = calloc(N_COLS(mx), sizeof rough_scratch[0])
; long* rough_priority = mcxAlloc(N_COLS(mx) * sizeof rough_priority[0], EXIT_ON_FAIL)
; for (i=0;i<N_COLS(mx);i++)
rough_priority[i] = 0
; for (i=0;i<N_COLS(mx);i++)
{ dim priority = 0
; rough_it(mx, tabulator, i, rough_scratch, rough_priority, &priority)
int main
( int argc
, const char* argv[]
)
{ mcxIO
*xfcl = NULL
, *xfctrl = NULL
, *xfcoarse= NULL
, *xfbase = NULL
, *xfcone = NULL
, *xfstack = NULL
; mclx* mxbase, *cl, *cl_coarse, *clprev, *clctrl = NULL
; mcxTing* shared = mcxTingNew("-I 4 -overlap split")
; mcxbool root = TRUE
; mcxbool have_bootstrap = FALSE
; const char* plexprefix = NULL
; const char* stem = "mcl"
; mcxbool same = FALSE
; mcxbool plex = TRUE
; mcxbool add_transpose = FALSE
; const char* b2opts = NULL
; const char* b1opts = NULL
; mcxbits write_modes = 0
; mclAlgParam* mlp = NULL
; mcxstatus status = STATUS_OK
; mcxstatus parse_status = STATUS_OK
; int multiplex_idx = 1
; int N = 0
; int n_ite = 0
; dim n_components = 0, n_cls = 0
; int a = 1, i= 0
; int n_arg_read = 0
; int delta = 0
; mcxOption* opts, *opt
; mcxTing* cline = mcxOptArgLine(argv+1, argc-1, '\'')
; mclgTF* transform = NULL
; mcxTing* transform_spec = NULL
; double iaf = 0.84
; mclx_app_init(stderr)
; if (0)
mcxLogLevel =
MCX_LOG_AGGR | MCX_LOG_MODULE | MCX_LOG_IO | MCX_LOG_GAUGE | MCX_LOG_WARN
; else
mcxLogLevelSetByString("xf4g1")
; mcxOptAnchorSortById(options, sizeof(options)/sizeof(mcxOptAnchor) -1)
; if (argc == 2 && argv[1][0] == '-' && mcxOptIsInfo(argv[1], options))
delta = 1
; else if (argc < 2)
{ help(options, shared)
; exit(0)
; }
opts = mcxOptExhaust
(options, (char**) argv, argc, 2-delta, &n_arg_read, &parse_status)
; if (parse_status != STATUS_OK)
{ mcxErr(me, "initialization failed")
; exit(1)
; }
; for (opt=opts;opt->anch;opt++)
{ mcxOptAnchor* anch = opt->anch
; switch(anch->id)
{ case MY_OPT_HELP
: help(options, shared)
; exit(0)
;
case MY_OPT_APROPOS
: help(options, shared)
; exit(0)
; break
;
case MY_OPT_NMAX
: N = atoi(opt->val)
; break
;
case MY_OPT_Z
: help(NULL, shared)
; exit(0)
; break
;
case MY_OPT_SHARED
: mcxTingPrintAfter(shared, " %s", opt->val)
; break
;
case MY_OPT_TRANSFORM
: transform_spec = mcxTingNew(opt->val)
; break
;
case MY_OPT_B1
: b1opts = opt->val
; break
;
case MY_OPT_B2
: b2opts = opt->val
; break
;
case ALG_OPT_SETENV
: mcxSetenv(opt->val)
; break
;
case ALG_OPT_QUIET
: mcxLogLevelSetByString(opt->val)
; break
;
case MY_OPT_HDP
: hdp_g = atof(opt->val)
; break
;
case MY_OPT_ADDTP
: add_transpose = TRUE
; break
;
case MY_OPT_ANNOT /* only used in command-line copying */
: break
;
case MY_OPT_IAF
: iaf = atof(opt->val) / 100
; break
;
case MY_OPT_WRITE
: if (strstr(opt->val, "stack"))
write_modes |= OUTPUT_STACK
; if (strstr(opt->val, "cone"))
write_modes |= OUTPUT_CONE
; if (strstr(opt->val, "levels"))
write_modes |= OUTPUT_STEPS
; if (strstr(opt->val, "coarse"))
write_modes |= OUTPUT_COARSE
; if (strstr(opt->val, "base"))
write_modes |= OUTPUT_BASE
; break
;
case MY_OPT_BASENAME
: xfbase = mcxIOnew(opt->val, "w")
; break
;
case MY_OPT_COARSE
: xfcoarse = mcxIOnew(opt->val, "w")
; break
;
case MY_OPT_CONE
: xfcone = mcxIOnew(opt->val, "w")
; break
;
case MY_OPT_ROOT
: root = strchr("1yY", (u8) opt->val[0]) ? TRUE : FALSE
; break
;
case MY_OPT_STACK
: xfstack = mcxIOnew(opt->val, "w")
; break
;
case MY_OPT_STEM
: stem = opt->val
; break
;
case MY_OPT_MULTIPLEX
: plex = strchr("yY1", (unsigned char) opt->val[0]) ? TRUE : FALSE
; break
;
case MY_OPT_DISPATCH
: dispatch_g = TRUE
; break
;
case MY_OPT_INTEGRATE
: integrate_g = TRUE
; break
;
case MY_OPT_CONTRACT
: break
;
case MY_OPT_SUBCLUSTERX
: subclusterx_g = TRUE, subcluster_g = TRUE
; break
;
case MY_OPT_SUBCLUSTER
: subcluster_g = TRUE
; break
;
case MY_OPT_CONTROL
: xfctrl = mcxIOnew(opt->val, "r")
; break
;
case MY_OPT_CL
: xfcl = mcxIOnew(opt->val, "r")
; have_bootstrap = TRUE
; break
;
case MY_OPT_VERSION
: app_report_version(me)
; exit(0)
;
default
: mcxExit(1)
;
}
}
mcxOptFree(&opts)
; a = 2 + n_arg_read
; if (a < argc)
{ if (strcmp(argv[a], "--"))
mcxDie
( 1
, me
, "trailing %s options require standalone '--' separator (found %s)"
, integrate_g ? "integrate" : "mcl"
, argv[a]
)
; a++
; }
if (subcluster_g + dispatch_g + integrate_g > 1)
mcxDie(1, me, "too many modes!")
; if (N && N < argc-a)
mcxErr(me, "-n argument leaves spurious option specifications")
; srandom(mcxSeed(89315))
; signal(SIGALRM, mclSigCatch)
; if (dispatch_g)
plexprefix = "dis"
; else if (!write_modes || (write_modes & OUTPUT_STEPS))
plexprefix = stem
; { mcxTing* tg = mcxTingEmpty(NULL, 30)
; if ((write_modes & OUTPUT_COARSE) && !xfcoarse)
mcxTingPrint(tg, "%s.%s", stem, "coarse")
, xfcoarse = mcxIOnew(tg->str, "w")
; if ((write_modes & OUTPUT_BASE) && !xfbase)
mcxTingPrint(tg, "%s.%s", stem, "base")
, xfbase = mcxIOnew(tg->str, "w")
; if
( (!write_modes || (write_modes & OUTPUT_CONE))
&& !xfcone
)
{ mcxTingPrint(tg, "%s.%s", stem, "cone")
; xfcone = mcxIOnew(tg->str, "w")
; mcxIOopen(xfcone, EXIT_ON_FAIL)
; fprintf(xfcone->fp, "# %s %s\n", argv[0], cline->str)
; }
if ((write_modes & OUTPUT_STACK) && !xfstack)
{ mcxTingPrint(tg, "%s.%s", stem, "stack")
; xfstack = mcxIOnew(tg->str, "w")
; mcxIOopen(xfstack, EXIT_ON_FAIL)
; fprintf(xfstack->fp, "# %s %s\n", argv[0], cline->str)
; }
mcxTingFree(&tg)
; }
if (integrate_g)
{ for (i=a;i<argc;i++)
{ mcxIO* xf = mcxIOnew(argv[i], "r")
; mclx* cl = mclxRead(xf, EXIT_ON_FAIL)
; mclxCatPush(&stck_g, cl, NULL, NULL, mclxCBdomStack, NULL, "dummy-integrate", n_cls++)
; }
integrate_results(&stck_g)
; if (xfstack)
mclxCatWrite(xfstack, &stck_g, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; if (xfcone)
mclxCatConify(&stck_g)
, mclxCatWrite(xfcone, &stck_g, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; return 0
; }
for (i=a;i<argc;i++)
{ if (get_interface(NULL, argv[1], shared->str, argv[i], NULL, 0, RETURN_ON_FAIL))
mcxDie(1, me, "error while testing mcl options viability (%s)", argv[i])
; }
mcxLog(MCX_LOG_APP, me, "pid %ld", (long) getpid())
/* make sure clusters align with this cluster
* status: does not seem promising.
*/
; if (xfctrl)
clctrl = mclxRead(xfctrl, EXIT_ON_FAIL)
;
/*
* Below: compute cl and mxbase.
*/
; if (xfcl)
{ cl = mclxRead(xfcl, EXIT_ON_FAIL)
; write_clustering
(cl, NULL, xfcone, xfstack, plexprefix, multiplex_idx++, NULL)
; if (subcluster_g || dispatch_g)
mclxCatPush(&stck_g, cl, NULL, NULL, mclxCBdomStack, NULL, "dummy-mclcm", n_cls++)
; mcxIOfree(&xfcl)
; if (!b1opts && !b2opts)
b1opts = ""
; mxbase = get_base(argv[1], NULL, b1opts, b2opts)
; }
else
{ mcxbits CACHE = b1opts || b2opts
? ALG_CACHE_INPUT /* cache, transform later */
: ALG_CACHE_START
; get_interface
( &mlp
, argv[1]
, shared->str
, a < argc ? argv[a] : NULL
, NULL
, CACHE
, EXIT_ON_FAIL
)
; if (a < argc)
a++
; if ((status = mclAlgorithm(mlp)) == STATUS_FAIL)
{ mcxErr(me, "failed at initial run")
; exit(1)
; }
cl_coarse = mclAlgParamRelease(mlp, mlp->cl_result)
; cl_coarse = control_test(cl_coarse, clctrl)
; write_clustering
(cl_coarse, NULL, xfcone, xfstack, plexprefix, multiplex_idx++, mlp)
; if (subcluster_g || dispatch_g)
mclxCatPush(&stck_g, cl_coarse, NULL, NULL, mclxCBdomStack, NULL, "dummy-mclcm", n_cls++)
; cl = cl_coarse
; n_ite++
; if (b1opts || b2opts)
{ mclx* mx_input = mclAlgParamRelease(mlp, mlp->mx_input)
; mxbase = get_base(NULL, mx_input, b1opts, b2opts)
/* ^ get_base frees mx_input */
; }
else
mxbase = mclAlgParamRelease(mlp, mlp->mx_start)
; }
clprev = cl
; mclAlgParamFree(&mlp, TRUE)
; if (xfbase)
{ dim nre = mclxNrofEntries(mxbase)
; mcxLog(MCX_LOG_APP, me, "base has %lu entries", (ulong) nre)
; mclxaWrite(mxbase, xfbase, MCLXIO_VALUE_GETENV, EXIT_ON_FAIL)
; mcxIOclose(xfbase)
; }
if (subcluster_g || dispatch_g)
iaf = iaf ? 1/iaf : 1.414
; while
( (!dispatch_g && (!N || n_ite < N))
|| (dispatch_g && a < argc)
)
{ mclx* mx_coarse = NULL, *clnext = NULL
; dim dist_new_prev = 0, dist_prev_new = 0
; mclx* clnew = NULL
; mcxbool faith = FALSE
; double inflation = -1.0
; if (subcluster_g)
mx_coarse
= subclusterx_g
? mclxBlockPartition(mxbase, clprev, 50)
: mclxBlockUnion(mxbase, clprev)
/* have to copy mxbase as mx_coarse is freed.
* Even if it were not freed, it is probably transformed.
*/
; else if (dispatch_g)
mx_coarse = mclxCopy(mxbase)
; else
{ mx_coarse = get_coarse(mxbase, clprev, add_transpose)
; if (n_ite == 1)
{ mclx* cc = clmUGraphComponents(mx_coarse, NULL) /* fixme; mx_coarse garantueed UD ? */
; n_components = N_COLS(cc)
; mclxFree(&cc)
; }
}
if (xfcoarse)
write_coarse(xfcoarse, mx_coarse)
; get_interface
( &mlp
, NULL
, shared->str
, a < argc ? argv[a] : NULL
, mx_coarse
, ALG_CACHE_START
, EXIT_ON_FAIL
)
; inflation = mlp->mpp->mainInflation
; BIT_OFF(mlp->modes, ALG_DO_SHOW_PID | ALG_DO_SHOW_JURY)
; if ((status = mclAlgorithm(mlp)) == STATUS_FAIL)
{ mcxErr(me, "failed")
; mcxExit(1)
; }
cl_coarse = mclAlgParamRelease(mlp, mlp->cl_result)
; if (xfcoarse)
mclxaWrite(cl_coarse, xfcoarse, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; if (dispatch_g || subcluster_g)
clnext = cl_coarse
; else
clnext = mclxCompose(clprev, cl_coarse, 0)
, clnext = control_test(clnext, clctrl)
, mclxFree(&cl_coarse)
; clmSJDistance
(clprev, clnext, NULL, NULL, &dist_prev_new, &dist_new_prev)
; if (dist_prev_new + dist_new_prev)
{ write_clustering
(clnext, clprev, xfcone, xfstack, plexprefix, multiplex_idx++, mlp)
; clnew = clnext
; if (subcluster_g || dispatch_g)
mclxCatPush(&stck_g, clnext, NULL, NULL, mclxCBdomStack, NULL, "dummy-mclcm", n_cls++)
; else
mclxFree(&clprev)
; clprev = clnew
; }
else if
( N_COLS(clnext) > n_components
&& inflation * iaf > 1.2
&& inflation * iaf < 10
)
{ mclxFree(&clnext)
; inflation *= iaf
; mcxTingPrintAfter(shared, " -I %.2f", inflation)
; mcxLog(MCX_LOG_APP, me, "setting inflation to %.2f", inflation)
; faith = TRUE
; }
/* i.e. vanilla mode, contraction */
else if (!subcluster_g && !dispatch_g)
{ mclx* cc
; mclxFree(&clnext)
; mclxAddTranspose(mx_coarse, 1.0)
; cc = clmUGraphComponents(mx_coarse, NULL)
; if (N_COLS(cc) < N_COLS(clprev))
{ mclx* ccback = mclxCompose(clprev, cc, 0)
; write_clustering
(ccback, clprev, xfcone, xfstack, plexprefix, multiplex_idx++, NULL)
; mclxFree(&clprev)
; clprev = ccback
; mcxTell(me, "connected components added as root clustering")
; }
if (root && N_COLS(cc) > 1)
{ mclx* root = mclxCartesian
( mclvCanonical(NULL, 1, 0)
, mclvCopy(NULL, mxbase->dom_cols)
, 1.0
)
; write_clustering
(root, clprev, xfcone, xfstack, plexprefix, multiplex_idx++, NULL)
; mclxFree(&clprev)
; mcxTell(me, "universe added as root clustering")
; clprev = root
; clnew = NULL
; }
mclxFree(&cc)
; }
else if (subcluster_g || dispatch_g)
mclxFree(&clnext)
; mclAlgParamFree(&mlp, TRUE) /* frees mx_coarse */
; if (!clnew && !faith)
{ same = TRUE
; break
; }
a++
; if (dispatch_g && a == argc)
break
; n_ite++
; }
if (same)
mcxLog(MCX_LOG_MODULE, me, "no further contraction: halting")
; if (dispatch_g)
integrate_results(&stck_g)
; else if (subcluster_g)
mclxCatReverse(&stck_g)
; if (dispatch_g || subcluster_g)
{ dim j
; if (xfstack)
mclxCatWrite(xfstack, &stck_g, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; if (xfcone && ! mclxCatConify(&stck_g))
mclxCatWrite(xfcone, &stck_g, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; for (j=0;j<stck_g.n_level;j++)
{ mclxAnnot* an = stck_g.level+j
; mclxFree(&an->mx)
; }
mcxFree(stck_g.level)
; }
mcxIOfree(&xfcoarse)
; mcxIOfree(&xfbase)
; mcxIOfree(&xfcone)
; mcxIOfree(&xfstack)
; mcxTingFree(&shared)
; if (!dispatch_g && !subcluster_g) /* fixme fixme fixme */
mclxFree(&clprev)
; mclxFree(&mxbase)
; mclvFree(&start_col_sums_g)
; mcxTingFree(&cline)
; helpful_reminder()
; return STATUS_OK
; }
