void clmCastActors
( mclx** mxpp /* is made stochastic and has loops added */
, mclx** clpp /* entries are set to self-value */
, mclx** el_to_clpp /* transpose of cl */
, mclx** el_on_clpp /* will be made stochastic */
, mclx** cl_on_clpp /* will be made stochastic */
, mclx** cl_on_elpp /* transpose of stochastic el_on_cl */
, double frac /* consider clusters in el_on_cl until frac
edge weight is covered */
)
{ mclxAdjustLoops(*mxpp, mclxLoopCBmax, NULL)
; mclxMakeStochastic(*mxpp)
; *el_to_clpp = mclxTranspose(*clpp)
/* el_to_cl not stochastic? */
; *el_on_clpp = mclxCompose(*el_to_clpp, *mxpp, 0, 1)
; mclxMakeStochastic(*el_on_clpp)
; *cl_on_clpp = mclxCompose(*el_on_clpp, *clpp, 0, 1)
; mclxMakeStochastic(*cl_on_clpp)
; set_cl_to_projection(*clpp, *el_on_clpp)
; prune_el_on_cl(*el_to_clpp, *el_on_clpp, frac, 10)
; *cl_on_elpp = mclxTranspose(*el_on_clpp)
; }
static mclx* get_coarse
( const mclx* mxbase
, mclx* clprev
, mcxbool add_transpose
)
{ mclx* blockc = mclxBlocksC(mxbase, clprev)
; mclx* clprevtp = mclxTranspose(clprev)
; mclx *p1 = NULL /* p_roduct */
; mclx* mx_coarse= NULL
; mclxMakeStochastic(clprev)
/****************** <EXPERIMENTAL CRAP> ************************************/
; if (hdp_g)
mclxUnary(clprev, fltxPower, &hdp_g)
/* parameter: use mxbase rather than blockc */
; if (getenv("MCLCM_BLOCK_STOCHASTIC")) /* this works very badly! */
mclxMakeStochastic(blockc)
; else if (getenv("MCLCM_BASE_UNSCALE") && start_col_sums_g)
{ dim i
; for (i=0;i<N_COLS(blockc);i++)
{ double f = start_col_sums_g->ivps[i].val
; mclvUnary(blockc->cols+i, fltxMul, &f)
; }
; }
/****************** </EXPERIMENTAL> *****************************************/
p1 = mclxCompose(blockc, clprev, 0)
;if (0)
{mcxIO* t = mcxIOnew("-", "w")
;mclxWrite(blockc, t, MCLXIO_VALUE_GETENV, EXIT_ON_FAIL)
;
}
; mclxFree(&blockc)
; mx_coarse = mclxCompose(clprevtp, p1, 0)
; if (add_transpose)
mclxAddTranspose(mx_coarse, 0.0)
; mclxAdjustLoops(mx_coarse, mclxLoopCBremove, NULL)
; mclxFree(&p1)
; mclxFree(&clprevtp)
; mclxMakeCharacteristic(clprev)
; return mx_coarse
; }
static void mclg_tf_step
( mclx* mx
, dim i
)
{ dim j
; mclx* input = mx
; for (j=0;j<i;j++)
{ mclx* st = mclxCompose(mx, mx, 0)
; if (j)
mclxFree(&mx)
; mx = st
; }
if (i)
mclxTransplant(input, &mx)
; }
void write_clustering
( mclx* cl
, const mclx* clprev
, mcxIO* xfcone
, mcxIO* xfstack
, const char* plexprefix
, int multiplex_idx
, const mclAlgParam* mlp
)
{
/* this branch is also taken for dispatch mode */
if (plexprefix)
{ mcxTing* clname = mcxTingPrint(NULL, "%s.%03d", plexprefix, multiplex_idx)
; mcxIO* xfout = mcxIOnew(clname->str, "w")
; if (dispatch_g && mlp && !mcxIOopen(xfout, RETURN_ON_FAIL))
fprintf(xfout->fp, "# %s\n", mlp->cline->str)
; mclxaWrite(cl, xfout, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; mcxTingFree(&clname)
; mcxIOfree(&xfout)
; }
if (subcluster_g || dispatch_g)
return
; if (xfstack)
mclxaWrite(cl, xfstack, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; if (xfcone && !clprev)
mclxaWrite(cl, xfcone, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; else if (xfcone)
{ mclx* clprevt = mclxTranspose(clprev)
; mclx* contracted = mclxCompose(clprevt, cl, 0)
; mclxMakeCharacteristic(contracted)
; mclxaWrite(contracted, xfcone, MCLXIO_VALUE_NONE, RETURN_ON_FAIL)
; mclxFree(&clprevt)
; mclxFree(&contracted)
; }
}
static mcxstatus mateMain
( int argc_unused cpl__unused
, const char* argv[]
)
{ mcxIO* xfx, *xfy
; mclx* mx, *my, *meet, *teem, *myt
; dim x, y
; mcxIOopen(xfout, EXIT_ON_FAIL)
; xfx = mcxIOnew(argv[0], "r")
; mx = mclxRead(xfx, EXIT_ON_FAIL)
; mcxIOclose(xfx)
; xfy = mcxIOnew(argv[1], "r")
; my = mclxRead(xfy, EXIT_ON_FAIL)
; myt = mclxTranspose(my)
; if (!MCLD_EQUAL(mx->dom_rows, my->dom_rows))
mcxDie(1, me, "domains are not equal")
; meet= mclxCompose(myt, mx, 0, 0) /* fixme thread interface */
; teem= mclxTranspose(meet)
; if (legend)
fprintf
( xfout->fp
, "%-10s %6s %6s %6s %6s %6s %6s %6s\n"
, "overlap"
, "x-idx"
, "y-idx"
, "meet"
, "xdiff"
, "ydiff"
, "x-size"
, "y-size"
)
; for (x=0;x<N_COLS(meet);x++)
{ mclv* xvec = meet->cols+x
; long X = xvec->vid
; long xsize = mx->cols[x].n_ivps
; if (one2many && xvec->n_ivps < 2)
continue
; for (y=0;y<N_COLS(teem);y++)
{ mclv* yvec = teem->cols+y
; long Y = yvec->vid
; long ysize = my->cols[y].n_ivps
; double twinfac
; long meetsize
; mclp* ivp = mclvGetIvp(yvec, X, NULL)
; if (!ivp)
continue
/*
* meet size, left diff, right diff, right size.
*/
; meetsize = ivp->val
; if (!xsize && !ysize) /* paranoia */
continue
; twinfac = 2 * meetsize / ( (double) (xsize + ysize) )
; if (xfout)
fprintf
( xfout->fp
, "%-10.3f %6ld %6ld %6ld %6ld %6ld %6ld %6ld\n"
, twinfac
, X
, Y
, meetsize
, xsize - meetsize
, ysize - meetsize
, xsize
, ysize
)
; }
}
return STATUS_OK
; }
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
; }