예제 #1
0
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)
;  }
예제 #2
0
파일: mclcm.c 프로젝트: ANS-math/SBEToolbox
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
;  }
예제 #3
0
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)
;  }
예제 #4
0
파일: mclcm.c 프로젝트: ANS-math/SBEToolbox
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)
   ;  }
   }
예제 #5
0
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
;  }
예제 #6
0
파일: mclcm.c 프로젝트: ANS-math/SBEToolbox
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
;  }