static void tf_do_mcl
( mclx* mx
, double infl
, mcxbool add_transpose
)
{ mclx* mx2 = NULL, *mx3 = NULL, *cl = NULL
; mclAlgParam* mlp = NULL
; char* argv2[] = { NULL }
; mcxstatus s
; if (add_transpose)
{ mx2 = mclxCopy(mx)
; mclxAddTranspose(mx2, 0.0)
; }
s = mclAlgInterface
( &mlp
, argv2
, 0
, NULL
, add_transpose ? mx2 : mx
, ALG_CACHE_INPUT
)
; do
{ if (s)
{ mcxErr("tf-mcl", "unexpected failure")
; break
; }
mlp->mpp->mainInflation = infl
; if (mclAlgorithm(mlp) == STATUS_FAIL)
break
; if (!(cl = mclAlgParamRelease(mlp, mlp->cl_result)))
break
; mclAlgParamRelease(mlp, mlp->mx_input) /* now we own it again, either mx2 or mx */
; mx3 = mclxBlockUnion2(mx, cl)
; mclxTransplant(mx, &mx3) /* this frees mx3 */
; }
while (0)
; mclxFree(&cl)
; mclxFree(&mx2)
; mclAlgParamFree(&mlp, TRUE)
; }
static mclx* get_base
( const char* fn_input
, mclx* mx_input
, const char* b1opts
, const char* b2opts
)
{ mclAlgParam* mlp = NULL
; mcxstatus status = STATUS_FAIL
; mclx* mxbase = NULL
; get_interface
( &mlp
, fn_input
, b2opts ? b2opts : b1opts
, NULL
, mx_input
, b2opts ? ALG_CACHE_EXPANDED : ALG_CACHE_START
, EXIT_ON_FAIL
)
; if (b2opts)
{ mlp->mpp->mainLoopLength = 1
; mlp->mpp->mainInflation = 1.0
; mlp->expand_only = TRUE
; mcxLog(MCX_LOG_APP, me, "computing expanded matrix")
; if ((status = mclAlgorithm(mlp)) == STATUS_FAIL)
{ mcxErr(me, "failed")
; mcxExit(1)
; }
mcxLog(MCX_LOG_APP, me, "done computing expanded matrix")
; mxbase = mclAlgParamRelease(mlp, mlp->mx_expanded)
; }
else
{ if (mclAlgorithmStart(mlp, FALSE))
mcxDie(1, me, "-b1 option start-up failed")
; mxbase = mclAlgParamRelease(mlp, mlp->mx_start)
; start_col_sums_g = mclvClone(mlp->mx_start_sums)
; }
mclAlgParamFree(&mlp, TRUE)
; return mxbase
; }
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
; }
