Beispiel #1
0
/* current dst content is thrown away if fltbinary not used */
mclv* mclvFromPAR
(  mclv*      dst
,  mclpAR*    par  
,  mcxbits    warnbits
,  void     (*ivpmerge)(void* ivp1, const void* ivp2)
,  double   (*fltbinary)(pval val1, pval val2)
)
   {  mcxbool  warn_re   =  warnbits & MCLV_WARN_REPEAT_ENTRIES
   ;  mcxbool  warn_rv   =  warnbits & MCLV_WARN_REPEAT_VECTORS
   ;  mclp*    ivps      =  par->ivps
   ;  dim      n_ivps    =  par->n_ivps
   ;  mcxbits  sortbits  =  par->sorted
   ;  dim      n_old     =  dst ? dst->n_ivps : 0
   ;  const char* me     =  "mclvFromPAR"
   ;  dim n_re = 0, n_rv = 0
   ;  if (!dst)
      dst = mclvInit(NULL)

   ;  if (n_ivps)
      {  if (dst->n_ivps && fltbinary)
         {  mclVector* tmpvec = mclvNew(ivps, n_ivps)

         ;  if (!(sortbits & MCLPAR_SORTED))
            mclvSort(tmpvec, NULL)

         ;  if (!(sortbits & MCLPAR_UNIQUE))
            n_re = mclvUniqIdx(tmpvec, ivpmerge)

         ;  n_rv += tmpvec->n_ivps
         ;  n_rv += dst->n_ivps
         ;  mclvBinary(dst, tmpvec, dst, fltbinary)
         ;  n_rv -= dst->n_ivps

         ;  mclvFree(&tmpvec)
      ;  }
         else
         {  if (dst->ivps == ivps)
            mcxErr(me, "DANGER dst->ivps == ivps (dst vid %d)", (int) dst->vid)

         ;  mclvRenew(dst, ivps, n_ivps)

         ;  if (!(sortbits & MCLPAR_SORTED))
            mclvSort(dst, NULL)

         ;  if (!(sortbits & MCLPAR_UNIQUE))
            n_re += mclvUniqIdx(dst, ivpmerge)
      ;  }
      }

      if (warn_re && n_re)
      mcxErr
      (  me
      ,  "<%ld> found <%ld> repeated entries within %svector"
      ,  (long) dst->vid
      ,  (long) n_re
      ,  n_rv ? "repeated " : ""
      )

   ;  if (warn_rv && n_rv)
      mcxErr
      (  me
      ,  "<%ld> new vector has <%ld> overlap with previous amalgam"
      ,  (long) dst->vid
      ,  (long) n_rv
      )

   ;  if (warnbits && n_re + n_rv)
      mcxErr
      (  me
      ,  "<%ld> vector went from <%ld> to <%ld> entries"
      ,  (long) dst->vid
      ,  (long) n_old
      ,  (long) dst->n_ivps
      )
   ;  return dst
;  }
Beispiel #2
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)
;  }
Beispiel #3
0
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
           ;
}
Beispiel #4
0
void mclgTFgraph
(  mclx* mx
,  pnum  mode
,  pval  val
)
   {  switch(mode)
      {        case MCLG_TF_MAX:       mclxMergeTranspose(mx, fltMax, 1.0)
   ;  break ;  case MCLG_TF_MIN:       mclxMergeTranspose(mx, fltMin, 1.0)
   ;  break ;  case MCLG_TF_ADD:       mclxMergeTranspose(mx, fltAdd, 1.0)
   ;  break ;  case MCLG_TF_SELFRM:    mclxAdjustLoops(mx, mclxLoopCBremove, NULL)
   ;  break ;  case MCLG_TF_SELFMAX:   mclxAdjustLoops(mx, mclxLoopCBmax, NULL)
   ;  break ;  case MCLG_TF_NORMSELF:  mclxNormSelf(mx)
   ;  break ;  case MCLG_TF_MUL:       mclxMergeTranspose(mx, fltMultiply, 1.0)
   ;  break ;  case MCLG_TF_ARCMAX:    mclxMergeTranspose(mx, fltArcMax, 1.0)

   ;  break ;  case MCLG_TF_ARCMAXGQ:  mclxMergeTranspose3(mx, fltArcMaxGQ, 1.0, val)
   ;  break ;  case MCLG_TF_ARCMAXGT:  mclxMergeTranspose3(mx, fltArcMaxGT, 1.0, val)
   ;  break ;  case MCLG_TF_ARCMAXLQ:  mclxMergeTranspose3(mx, fltArcMaxLQ, 1.0, val)
   ;  break ;  case MCLG_TF_ARCMAXLT:  mclxMergeTranspose3(mx, fltArcMaxLT, 1.0, val)

   ;  break ;  case MCLG_TF_ARCMINGQ:  mclxMergeTranspose3(mx, fltArcMinGQ, 1.0, val)
   ;  break ;  case MCLG_TF_ARCMINGT:  mclxMergeTranspose3(mx, fltArcMinGT, 1.0, val)
   ;  break ;  case MCLG_TF_ARCMINLQ:  mclxMergeTranspose3(mx, fltArcMinLQ, 1.0, val)
   ;  break ;  case MCLG_TF_ARCMINLT:  mclxMergeTranspose3(mx, fltArcMinLT, 1.0, val)

   ;  break ;  case MCLG_TF_ARCDIFFGQ: mclxMergeTranspose3(mx, fltArcDiffGQ, 1.0, val)
   ;  break ;  case MCLG_TF_ARCDIFFGT: mclxMergeTranspose3(mx, fltArcDiffGT, 1.0, val)
   ;  break ;  case MCLG_TF_ARCDIFFLQ: mclxMergeTranspose3(mx, fltArcDiffLQ, 1.0, val)
   ;  break ;  case MCLG_TF_ARCDIFFLT: mclxMergeTranspose3(mx, fltArcDiffLT, 1.0, val)

   ;  break ;  case MCLG_TF_ARCSUB:    mclxMergeTranspose(mx, fltSubtract, 1.0)
   ;  break ;  case MCLG_TF_TUG:       mclxPerturb(mx, val, MCLX_PERTURB_SYMMETRIC)
   ;  break ;  case MCLG_TF_TRANSPOSE: { mclx* tp = mclxTranspose(mx); mclxTransplant(mx, &tp); }
   ;  break ;  case MCLG_TF_SHRUG:     mclxPerturb(mx, val, MCLX_PERTURB_SYMMETRIC | MCLX_PERTURB_RAND)
   ;  break ;  case MCLG_TF_ILS:       mclxILS(mx)
   ;  break ;  case MCLG_TF_TOPN:      mclxKNNdispatch(mx, val+0.5, mclx_n_thread_g, 0)
   ;  break ;  case MCLG_TF_KNN:       mclxKNNdispatch(mx, val+0.5, mclx_n_thread_g, 1)
   ;  break ;  case MCLG_TF_MCL:       tf_do_mcl(mx, val, FALSE)
   ;  break ;  case MCLG_TF_ARC_MCL:   tf_do_mcl(mx, val, TRUE)
   ;  break ;  case MCLG_TF_THREAD:    mclx_n_thread_g = val + 0.5
   ;  break ;  case MCLG_TF_CEILNB:    { mclv* cv = mclgCeilNB(mx, val+0.5, NULL, NULL, NULL); mclvFree(&cv); }
   ;  break ;  case MCLG_TF_STEP:      mclg_tf_step(mx, val+0.5)
   ;  break ;  case MCLG_TF_QT:        mclxQuantiles(mx, val)
   ;  break ;  case MCLG_TF_SSQ:       tf_ssq(mx, val)
   ;  break ;  case MCLG_TF_SHUFFLE:   mcxErr("mclgTFgraph", "shuffle not yet done (lift from mcxrand)")
   ;  break ;  default:                mcxErr("mclgTFgraph", "unknown mode")
   ;  break
   ;  }
   }
Beispiel #5
0
static void vary_threshold
(  mcxIO* xf
,  FILE*  fp
,  int vary_a
,  int vary_z
,  int vary_s
,  int vary_n
,  unsigned mode
)
   {  dim cor_i = 0, j
   ;  int step

   ;  mclx* mx
   ;  unsigned long noe
   ;  pval*  allvals
   ;  dim  n_allvals = 0
   ;  double sum_vals = 0.0

   ;  mx = mclxRead(xf, EXIT_ON_FAIL)
   ;  mcxIOclose(xf)

   ;  if (transform)
      mclgTFexec(mx, transform)

   ;  noe = mclxNrofEntries(mx)
   ;  allvals = mcxAlloc(noe * sizeof allvals[0], EXIT_ON_FAIL)

   ;  if (!weight_scale)
      {  if (mode == 'c')
         weight_scale = 1.0
      ;  else
         weight_scale = vary_n
   ;  }

      n_allvals = get_n_sort_allvals(mx, allvals, noe, &sum_vals, FALSE)

   ;  if (mode == 'c')
      {  double smallest = n_allvals ? allvals[n_allvals-1] : -DBL_MAX
      ;  if (vary_a * 1.0 / vary_n < smallest)
         {  while (vary_a * 1.0 / vary_n < smallest)
            vary_a++
         ;  vary_a--
      ;  }
         mcxTell
         (  me
         ,  "smallest correlation is %.2f, using starting point %.2f"
         ,  smallest
         ,  vary_a * 1.0 / vary_n
         )
   ;  }

      if (output_flags & OUTPUT_TABLE)
      {
;fprintf(fp, "L\tD\tR\tS\tcce\tEWmean\tEWmed\tEWiqr\tNDmean\tNDmed\tNDiqr\tCCF\t%s\n", mode == 'k' ? "kNN" : mode == 'l' ? "N" : "Cutoff")
;}    else
      {  if (output_flags & OUTPUT_KEY)
 {
;fprintf(fp, "-------------------------------------------------------------------------------\n")
;fprintf(fp, " L       Percentage of nodes in the largest component\n")
;fprintf(fp, " D       Percentage of nodes in components of size at most %d [-div option]\n", (int) divide_g)
;fprintf(fp, " R       Percentage of nodes not in L or D: 100 - L -D\n")
;fprintf(fp, " S       Percentage of nodes that are singletons\n")
;fprintf(fp, " cce     Expected size of component, nodewise [ sum(sz^2) / sum^2(sz) ]\n")
;fprintf(fp, "*EW      Edge weight traits (mean, median and IQR, all scaled!)\n")
;fprintf(fp, "            Scaling is used to avoid printing of fractional parts throughout.\n")
;fprintf(fp, "            The scaling factor is %.2f [-report-scale option]\n", weight_scale)
;fprintf(fp, " ND      Node degree traits [mean, median and IQR]\n")
;fprintf(fp, " CCF     Clustering coefficient %s\n", compute_flags & COMPUTE_CLCF ? "(not computed; use --clcf to include this)" : "")
;fprintf(fp, " eff     Induced component efficiency %s\n", compute_flags & COMPUTE_EFF ? "(not computed; use --eff to include this)" : "")

;if (mode == 'c')
 fprintf(fp, "Cutoff   The threshold used.\n")
;else if (mode == 't')
 fprintf(fp, "*Cutoff  The threshold with scale factor %.2f and fractional parts removed\n", weight_scale)
;else if (mode == 'k')
 fprintf(fp, "k-NN     The knn parameter\n")
;else if (mode == 'l')
 fprintf(fp, "N        The knn parameter (merge mode)\n")
;else if (mode == 'n')
 fprintf(fp, "ceil     The ceil parameter\n")
;fprintf(fp, "Total number of nodes: %lu\n", (ulong) N_COLS(mx))
;}
 fprintf(fp, "-------------------------------------------------------------------------------\n")
;fprintf(fp, "  L   D   R   S     cce *EWmean  *EWmed *EWiqr NDmean  NDmed  NDiqr CCF  eff %6s \n", mode == 'k' ? "k-NN" : mode == 'l' ? "N" : mode == 'n' ? "Ceil" : "Cutoff")
;fprintf(fp, "-------------------------------------------------------------------------------\n")
;     }

      for (step = vary_a; step <= vary_z; step += vary_s)
      {  double cutoff = step * 1.0 / vary_n
      ;  double eff = -1.0
      ;  mclv* nnodes = mclvCanonical(NULL, N_COLS(mx), 0.0)
      ;  mclv* degree = mclvCanonical(NULL, N_COLS(mx), 0.0)
      ;  dim i, n_sample = 0
      ;  double cor, y_prev, iqr = 0.0
      ;  mclx* cc = NULL, *res = NULL
      ;  mclv* sz, *ccsz = NULL
      ;  int step2 = vary_z + vary_a - step

      ;  sum_vals = 0.0
      
      ;  if (mode == 't' || mode == 'c')
            mclxSelectValues(mx, &cutoff, NULL, MCLX_EQT_GQ)
         ,  res = mx
      ;  else if (mode == 'k')
         {  res = rebase_g ? mclxCopy(mx) : mx
         ;  mclxKNNdispatch(res, step2, n_thread_l, 1)
      ;  }
         else if (mode == 'l')
         {  res = mx
         ;  mclxKNNdispatch(res, step2, n_thread_l, 0)
      ;  }
         else if (mode == 'n')
         {  res = rebase_g ? mclxCopy(mx) : mx
         ;  mclv* cv = mclgCeilNB(res, step2, NULL, NULL, NULL)
         ;  mclvFree(&cv)
      ;  }

         sz = mclxColSizes(res, MCL_VECTOR_COMPLETE)
      ;  mclvSortDescVal(sz)

      ;  cc = clmUGraphComponents(res, NULL)     /* fixme: user has to specify -tf '#max()' if graph is directed */
      ;  if (cc)
         {  ccsz = mclxColSizes(cc, MCL_VECTOR_COMPLETE)
         ;  if (compute_flags & COMPUTE_EFF)
            {  clmPerformanceTable pftable
            ;  clmPerformance(mx, cc, &pftable)
            ;  eff = pftable.efficiency
         ;  }
         }

         if (mode == 't' || mode == 'c')
         {  for
            (
            ;  n_allvals > 0 && allvals[n_allvals-1] < cutoff
            ;  n_allvals--
            )
         ;  sum_vals = 0.0
         ;  for (i=0;i<n_allvals;i++)
            sum_vals += allvals[i]
      ;  }
         else if (mode == 'k' || mode == 'n' || mode == 'l')
         {  n_allvals = get_n_sort_allvals(res, allvals, noe, &sum_vals, FALSE)
      ;  }

         levels[cor_i].sim_median=  mcxMedian(allvals, n_allvals, sizeof allvals[0], pval_get_double, &iqr)
      ;  levels[cor_i].sim_iqr   =  iqr
      ;  levels[cor_i].sim_mean  =  n_allvals ? sum_vals / n_allvals : 0.0

      ;  levels[cor_i].nb_median =  mcxMedian(sz->ivps, sz->n_ivps, sizeof sz->ivps[0], ivp_get_double, &iqr)
      ;  levels[cor_i].nb_iqr    =  iqr
      ;  levels[cor_i].nb_mean   =  mclvSum(sz) / N_COLS(res)
      ;  levels[cor_i].cc_exp    =  cc ? mclvPowSum(ccsz, 2.0) / N_COLS(res) : 0
      ;  levels[cor_i].nb_sum    =  mclxNrofEntries(res)

      ;  if (compute_flags & COMPUTE_CLCF)
         {  mclv* clcf = mclgCLCFdispatch(res, n_thread_l)
         ;  levels[cor_i].clcf   =  mclvSum(clcf) / N_COLS(mx)
         ;  mclvFree(&clcf)
      ;  }
         else
         levels[cor_i].clcf = 0.0

      ;  levels[cor_i].threshold =  mode == 'k' || mode == 'l' || mode == 'n' ? step2 : cutoff
      ;  levels[cor_i].bigsize   =  cc ? cc->cols[0].n_ivps : 0
      ;  levels[cor_i].n_single  =  0
      ;  levels[cor_i].n_edge    =  n_allvals
      ;  levels[cor_i].n_lq      =  0

      ;  if (cc)
         for (i=0;i<N_COLS(cc);i++)
         {  dim n = cc->cols[N_COLS(cc)-1-i].n_ivps
         ;  if (n == 1)
            levels[cor_i].n_single++
         ;  if (n <= divide_g)
            levels[cor_i].n_lq += n
         ;  else
            break
      ;  }

         if (levels[cor_i].bigsize <= divide_g)
         levels[cor_i].bigsize = 0

      ;  y_prev = sz->ivps[0].val

                  /* wiki says:
                     A scale-free network is a network whose degree distribution follows a power
                     law, at least asymptotically. That is, the fraction P(k) of nodes in the
                     network having k connections to other nodes goes for large values of k as P(k)
                     ~ k^−g where g is a constant whose value is typically in the range 2<g<3,
                     although occasionally it may lie outside these bounds.
                 */
      ;  for (i=1;i<sz->n_ivps;i++)
         {  double y = sz->ivps[i].val
         ;  if (y > y_prev - 0.5)
            continue                                              /* same as node degree seen last */
         ;  nnodes->ivps[n_sample].val = log( (i*1.0) / (1.0*N_COLS(res)))    /* x = #nodes >= k, as fraction   */
         ;  degree->ivps[n_sample].val = log(y_prev ? y_prev : 1)            /* y = k = degree of node         */
         ;  n_sample++
;if(0)fprintf(stderr, "k=%.0f\tn=%d\t%.3f\t%.3f\n", (double) y_prev, (int) i, (double) nnodes->ivps[n_sample-1].val, (double) degree->ivps[n_sample-1].val)
         ;  y_prev = y
      ;  }
         nnodes->ivps[n_sample].val = 0
      ;  nnodes->ivps[n_sample++].val = log(y_prev ? y_prev : 1)
;if(0){fprintf(stderr, "k=%.0f\tn=%d\t%.3f\t%.3f\n", (double) sz->ivps[sz->n_ivps-1].val, (int) N_COLS(res), (double) nnodes->ivps[n_sample-1].val, (double) degree->ivps[n_sample-1].val)
;}

      ;  mclvResize(nnodes, n_sample)
      ;  mclvResize(degree, n_sample)
      ;  cor = pearson(nnodes, degree, n_sample)

      ;  levels[cor_i].degree_cor =  cor * cor

;if(0)fprintf(stdout, "cor at cutoff %.2f %.3f\n\n", cutoff, levels[cor_i-1].degree_cor)
      ;  mclvFree(&nnodes)
      ;  mclvFree(&degree)
      ;  mclvFree(&sz)
      ;  mclvFree(&ccsz)
      ;  mclxFree(&cc)

;  if(output_flags & OUTPUT_TABLE)
   {  fprintf
      (  fp
      ,  "%lu\t%lu\t%lu\t%lu\t%lu"
         "\t%6g\t%6g\t%6g"
         "\t%6g\t%lu\t%6g"

      ,  (ulong) levels[cor_i].bigsize
      ,  (ulong) levels[cor_i].n_lq
      ,  (ulong) N_COLS(mx) - levels[cor_i].bigsize - levels[cor_i].n_lq
      ,  (ulong) levels[cor_i].n_single
      ,  (ulong) levels[cor_i].cc_exp

      ,  (double) levels[cor_i].sim_mean
      ,  (double) levels[cor_i].sim_median
      ,  (double) levels[cor_i].sim_iqr

      ,  (double) levels[cor_i].nb_mean
      ,  (ulong) levels[cor_i].nb_median
      ,  (double) levels[cor_i].nb_iqr
      )

   ;  if (compute_flags & COMPUTE_CLCF) fprintf(fp, "\t%6g", levels[cor_i].clcf)   ;  else fputs("\tNA", fp)
   ;  if (eff >= 0.0) fprintf(fp, "\t%4g", eff)              ;  else fputs("\tNA", fp)

   ;  fprintf(fp, "\t%6g", (double) levels[cor_i].threshold)
   ;  fputc('\n', fp)
;  }
   else
   {  fprintf
      (  fp
      ,  "%3d %3d %3d %3d %7d "
         "%7.0f %7.0f %6.0f"
         "%6.1f %6.0f %6.0f"

      ,  0 ? 1 : (int) (0.5 + (100.0 * levels[cor_i].bigsize) / N_COLS(mx))
      ,  0 ? 1 : (int) (0.5 + (100.0 * levels[cor_i].n_lq) / N_COLS(mx))
      ,  0 ? 1 : (int) (0.5 + (100.0 * (N_COLS(mx) - levels[cor_i].bigsize - levels[cor_i].n_lq)) / N_COLS(mx))
      ,  0 ? 1 : (int) (0.5 + (100.0 * levels[cor_i].n_single) / N_COLS(mx))
      ,  0 ? 1 : (int) (0.5 + levels[cor_i].cc_exp)

      ,  0 ? 1.0 : (double) (levels[cor_i].sim_mean   * weight_scale)
      ,  0 ? 1.0 : (double) (levels[cor_i].sim_median * weight_scale)
      ,  0 ? 1.0 : (double) (levels[cor_i].sim_iqr    * weight_scale)

      ,  0 ? 1.0 : (double) (levels[cor_i].nb_mean                 )
      ,  0 ? 1.0 : (double) (levels[cor_i].nb_median + 0.5         )
      ,  0 ? 1.0 : (double) (levels[cor_i].nb_iqr + 0.5            )
      )

   ;  if (compute_flags & COMPUTE_CLCF)
      fprintf(fp, " %3d", 0 ? 1 : (int) (0.5 + (100.0 * levels[cor_i].clcf)))
   ;  else
      fputs("   -", fp)

   ;  if (eff >= 0.0)
      fprintf(fp, "  %3d", (int) (0.5 + 1000 * eff))
   ;  else
      fputs("    -", fp)

   ;  if (mode == 'c')
      fprintf(fp, "%8.2f\n", (double) levels[cor_i].threshold)
   ;  else if (mode == 't')
      fprintf(fp, "%8.0f\n", (double) levels[cor_i].threshold  * weight_scale)
   ;  else if (mode == 'k' || mode == 'n' || mode == 'l')
      fprintf(fp, "%8.0f\n", (double) levels[cor_i].threshold)
 ; }

      ;  cor_i++
      ;  if (res != mx)
         mclxFree(&res)
   ;  }

   if (!(output_flags & OUTPUT_TABLE))
   {  if (weefreemen)
      {
fprintf(fp, "-------------------------------------------------------------------------------\n")
;fprintf(fp, "The graph below plots the R^2 squared value for the fit of a log-log plot of\n")
;fprintf(fp, "<node degree k> versus <#nodes with degree >= k>, for the network resulting\n")
;fprintf(fp, "from applying a particular %s cutoff.\n", mode == 'c' ? "correlation" : "similarity")
;fprintf(fp, "-------------------------------------------------------------------------------\n")
   ;  for (j=0;j<cor_i;j++)
      {  dim jj
      ;  for (jj=30;jj<=100;jj++)
         {  char c = ' '
         ;  if (jj * 0.01 < levels[j].degree_cor && (jj+1.0) * 0.01 > levels[j].degree_cor)
            c = 'X'
         ;  else if (jj % 5 == 0)
            c = '|'
         ;  fputc(c, fp)
      ;  }
         if (mode == 'c')
         fprintf(fp, "%8.2f\n", (double) levels[j].threshold)
      ;  else
         fprintf(fp, "%8.0f\n", (double) levels[j].threshold * weight_scale)
   ;  }

 fprintf(fp, "|----+----|----+----|----+----|----+----|----+----|----+----|----+----|--------\n")
;fprintf(fp, "| R^2   0.4       0.5       0.6       0.7       0.8       0.9    |  1.0    -o)\n")
;fprintf(fp, "+----+----+----+----+----+---------+----+----+----+----+----+----+----+    /\\\\\n")
;fprintf(fp, "| 2 4 6 8   2 4 6 8 | 2 4 6 8 | 2 4 6 8 | 2 4 6 8 | 2 4 6 8 | 2 4 6 8 |   _\\_/\n")
;fprintf(fp, "+----+----|----+----|----+----|----+----|----+----|----+----|----+----+--------\n")
;     }
      else
      fprintf(fp, "-------------------------------------------------------------------------------\n")
;  }

      mclxFree(&mx)
   ;  mcxFree(allvals)
;  }
Beispiel #6
0
double get_score
(  const mclv* c
,  const mclv* d
,  const mclv* c_start
,  const mclv* d_start
,  const mclv* c_end
,  const mclv* d_end
)
   {  mclv* vecc   = mclvClone(c)
   ;  mclv* vecd   = mclvClone(d)
   ;  mclv* meet_c = mcldMeet(vecc, vecd, NULL)
   ;  mclv* meet_d = mcldMeet(vecd, meet_c, NULL)

   ;  mclv* cwid   = mclvBinary(c_end, c_start, NULL, fltSubtract)
   ;  mclv* dwid   = mclvBinary(d_end, d_start, NULL, fltSubtract)

   ;  mclv* rmin   = mclvBinary(c_end, d_end, NULL, fltMin)
   ;  mclv* lmax   = mclvBinary(c_start, d_start, NULL, fltMax)
   ;  mclv* delta  = mclvBinary(rmin, lmax, NULL, fltSubtract)

   ;  mclv* weightc, *weightd
   ;  double ip, cd, csn, meanc, meand, mean, euclid, meet_fraction, score, sum_meet_c, sum_meet_d, reduction_c, reduction_d

   ;  int nmeet = meet_c->n_ivps
   ;  int nldif = vecc->n_ivps - nmeet
   ;  int nrdif = vecd->n_ivps - nmeet

   ;  mclvSelectGqBar(delta, 0.0)

   ;  weightc= mclvBinary(delta, cwid, NULL, mydiv)
   ;  weightd= mclvBinary(delta, dwid, NULL, mydiv)

#if 0
;if (c != d)mclvaDump
(  cwid
,  stdout
,  5
,  "\n"
,  0)
,mclvaDump
(  dwid
,  stdout
,  5
,  "\n"
,  0)
#endif

   ;  sum_meet_c  = 0.01 + mclvSum(meet_c)
   ;  sum_meet_d  = 0.01 + mclvSum(meet_d)

   ;  mclvBinary(meet_c, weightc, meet_c, fltMultiply)
   ;  mclvBinary(meet_d, weightd, meet_d, fltMultiply)

   ;  reduction_c = mclvSum(meet_c) / sum_meet_c
   ;  reduction_d = mclvSum(meet_d) / sum_meet_d

   ;  ip    = mclvIn(meet_c, meet_d)
   ;  cd    = sqrt(mclvPowSum(meet_c, 2.0) * mclvPowSum(meet_d, 2.0))
   ;  csn   = cd ? ip / cd : 0.0
   ;  meanc = meet_c->n_ivps ? mclvSum(meet_c) / meet_c->n_ivps : 0.0
   ;  meand = meet_d->n_ivps ? mclvSum(meet_d) / meet_d->n_ivps : 0.0
   ;  mean  = MCX_MIN(meanc, meand)

   ;  euclid =   0
              ?  1.0
              :  (  mean
                 ?  sqrt(mclvPowSum(meet_c, 2.0) / mclvPowSum(vecc, 2.0))
                 :  0.0
                 )
   ;  meet_fraction = pow((meet_c->n_ivps * 1.0 / vecc->n_ivps), 1.0)

   ;  score  =  mean * csn * euclid  * meet_fraction * 1.0

   ;  mclvFree(&meet_c)
   ;  mclvFree(&meet_d)

   ;  fprintf
      (  stdout
      ,  "%10d%10d%10d%10d%10d%10g%10g%10g%10g%10g%10g%10g\n"
      ,  (int) c->vid
      ,  (int) d->vid
      ,  (int) nldif
      ,  (int) nrdif
      ,  (int) nmeet
      ,  score
      ,  mean
      ,  csn
      ,  euclid
      ,  meet_fraction
      ,  reduction_c
      ,  reduction_d
      )

   ;  return score
;  }
Beispiel #7
0
static mclx* make_mx_from_pars
(  mclxIOstreamer* streamer
,  stream_state* iface
,  void  (*ivpmerge)(void* ivp1, const void* ivp2)
,  mcxbits bits
)
   {  mclpAR* pars = iface->pars
   ;  long dc_max_seen = iface->map_c->max_seen
   ;  long dr_max_seen = iface->map_r->max_seen
   ;  mclx* mx = NULL
   ;  mclv* domc, *domr
   ;  dim i

   ;  if (bits & MCLXIO_STREAM_235ANY)
      {  if (streamer->cmax_235 > 0 && dc_max_seen < streamer->cmax_235 - 1)
         dc_max_seen = streamer->cmax_235-1
   ;  }
      else if (bits & MCLXIO_STREAM_123)
      {  if (streamer->cmax_123 > 0 && dc_max_seen < streamer->cmax_123 - 1)
         dc_max_seen = streamer->cmax_123-1
      ;  if (streamer->rmax_123 > 0 && dr_max_seen < streamer->rmax_123 - 1)
         dr_max_seen = streamer->rmax_123-1
   ;  }

mcxTell("stream", "maxc=%d maxr=%d", (int) dc_max_seen, (int) dr_max_seen)

   ;  if (iface->pars_n_used != iface->map_c->max_seen+1)
      mcxDie
      (  1
      ,  module
      ,  "internal discrepancy: n_pars=%lu max_seen+1=%lu"
      ,  (ulong) iface->pars_n_used
      ,  (ulong) (iface->map_c->max_seen+1)
      )

   ;  if (dc_max_seen < 0 || dr_max_seen < 0)
      {  if (dc_max_seen < -1 || dr_max_seen < -1)
         {  mcxErr(module, "bad apples %ld %ld", dc_max_seen, dr_max_seen)
         ;  return NULL
      ;  }
         else
         mcxTell(module, "no assignments yield void/empty matrix")
   ;  }

                           /* fixme: with extend and same tab, should still copy.
                            * then, there are still occasions where one would
                            * want to go the sparse route
                           */
      domc  =     iface->map_c->tab && (iface->bits & MCLXIO_STREAM_CTAB_RO)
               ?  mclvClone(iface->map_c->tab->domain)
               :  mclvCanonical(NULL, dc_max_seen+1, 1.0)
   ;  domr  =     iface->map_r->tab && (iface->bits & MCLXIO_STREAM_RTAB_RO)
               ?  mclvClone(iface->map_r->tab->domain)
               :  mclvCanonical(NULL, dr_max_seen+1, 1.0)
      
   ;  if (! (mx = mclxAllocZero(domc, domr)))
      {  mclvFree(&domc)
      ;  mclvFree(&domr)
   ;  }
      else
      for (i=0;i<iface->pars_n_used;i++)  /* careful with signedness */
      {  long d = domc->ivps[i].idx
;if(DEBUG3)fprintf(stderr, "column %d alloc %d\n", (int) d, (int) iface->pars_n_alloc);
      ;  mclvFromPAR(mx->cols+i, pars+d, 0, ivpmerge, NULL)
   ;  }
      return mx
;  }
Beispiel #8
0
void get_attr
(  mclx* mx
,  mclTab* tab
,  mcxIO* xfattr
)
   {  mclx* tp = mclxTranspose(mx)
   ;  mclx* G  = mclxAdd(mx, tp)
   ;  mclv* fwd = mclxColSizes(mx, MCL_VECTOR_COMPLETE)
   ;  mclv* bwd = mclxColSizes(tp, MCL_VECTOR_COMPLETE)
   ;  mclx* cc = clmComponents(G, NULL)
   ;  mclx* node2cc = mclxTranspose(cc)
   ;  dim i, n_cycle = 0

   ;  fprintf(xfattr->fp, "node\tup\tdown\tnparent\tnchild\tndag\n")

   ;  for (i=0;i<bwd->n_ivps;i++)
      {  mclv* seenpp1 = NULL, *seenpp2 = NULL

      ;  ofs level_up = fire_node(mx, i, &seenpp1)
      ;  ofs level_dn = fire_node(tp, i, &seenpp2)
      ;  ofs ccidx = node2cc->cols[i].ivps[0].idx
      ;  dim ccsize = cc->cols[ccidx].n_ivps

      ;  mclvFree(&seenpp1)
      ;  mclvFree(&seenpp2)

      ;  if ((i+1) % 500 == 0)
         fputc('.', stderr)
      ;  if (tab)
         {  const char* label = mclTabGet(tab, mx->cols[i].vid, NULL)
         ;  fputs(label, xfattr->fp)
         ;  fputc('\t', xfattr->fp)
      ;  }
         else
         fprintf
         (  xfattr->fp
         ,  "%lu\t"
         ,  (ulong) mx->cols[i].vid
         )

      ;  fprintf
         (  xfattr->fp
         ,  "%ld\t%ld\t%lu\t%lu\t%lu\n"
         ,  (long) level_up
         ,  (long) level_dn
         ,  (ulong) fwd->ivps[i].val
         ,  (ulong) bwd->ivps[i].val
         ,  (ulong) ccsize
         )

      ;  if (level_up < 0 || level_dn < 0)
            fputc('.', stderr)
         ,  n_cycle++
   ;  }

      if (n_cycle)
      fputc('\n', stderr)
   ;  mclvFree(&bwd)
   ;  mclvFree(&fwd)
   ;  mclxFree(&tp)
;  }
Beispiel #9
0
int main
(  int                  argc
,  const char*          argv[]
)  
   {  mcxIO* xfdagreduce = NULL, *xfattr = NULL, *xfdiff = NULL
   ;  double child_diff_lq = 0.2
   ;  double parent_diff_gq = 0.4
   ;  mcxIO* xfimx = mcxIOnew("-", "r"), *xfdag = NULL, *xftab = NULL
   ;  mclTab* tab = NULL
   ;  int q = -1
   ;  mclx* mx
   ;  unsigned char test_mode = 0

   ;  mcxstatus parseStatus = STATUS_OK
   ;  mcxOption* opts, *opt
   ;  mcxOptAnchorSortById(options, sizeof(options)/sizeof(mcxOptAnchor) -1)
   
   ;  if
      (!(opts = mcxOptParse(options, (char**) argv, argc, 1, 0, &parseStatus)))
      exit(0)

   ;  mcxLogLevel =
      MCX_LOG_AGGR | MCX_LOG_MODULE | MCX_LOG_IO | MCX_LOG_GAUGE | MCX_LOG_WARN
   ;  mclxIOsetQMode("MCLXIOVERBOSITY", MCL_APP_VB_YES)
   ;  mclx_app_init(stderr)


   ;  for (opt=opts;opt->anch;opt++)
      {  mcxOptAnchor* anch = opt->anch

      ;  switch(anch->id)
         {  case MY_OPT_HELP
         :  mcxOptApropos(stdout, me, syntax, 0, 0, options)
         ;  return 0
         ;

            case MY_OPT_VERSION
         :  app_report_version(me)
         ;  return 0
         ;

            case MY_OPT_TEST_CYCLE
         :  test_mode = 'c'
         ;  break
         ;

            case MY_OPT_TEST_CROSS
         :  test_mode = 'x'
         ;  break
         ;

            case MY_OPT_DAG_ATTR
         :  xfattr = mcxIOnew(opt->val, "w")
         ;  mcxIOopen(xfattr, EXIT_ON_FAIL)
         ;  break
         ;

            case MY_OPT_DAG_DIFF
         :  xfdiff = mcxIOnew(opt->val, "w")
         ;  break
         ;

            case MY_OPT_DAG_REDUCE
         :  xfdagreduce = mcxIOnew(opt->val, "w")
         ;  break
         ;

            case MY_OPT_CHILD_DIFF_LQ
         :  child_diff_lq = atof(opt->val)
         ;  break
         ;

            case MY_OPT_PARENT_DIFF_GQ
         :  parent_diff_gq = atof(opt->val)
         ;  break
         ;

            case MY_OPT_QUERY
         :  q = atoi(opt->val)
         ;  break
         ;

            case MY_OPT_TAB
         :  xftab = mcxIOnew(opt->val, "r")
         ;  break
         ;

            case MY_OPT_IMX
         :  mcxIOnewName(xfimx, opt->val)
         ;  break
         ;
         }
      }

   ;  if (xfimx)
      mx = mclxRead(xfimx, EXIT_ON_FAIL)
   ;  else
      mcxDie(1, me, "need -imx")

   ;  if (xftab)
      tab = mclTabRead(xftab, mx->dom_cols, EXIT_ON_FAIL)

   ;  if (test_mode == 'c')
      test_for_cycles(mx)

   ;  else if (test_mode == 'x')
      test_cross_ratio(mx)

   ;  else if (xfattr)
      get_attr(mx, tab, xfattr)

   ;  else if (xfdagreduce)
      {  mclxComposeHelper* ch = mclxComposePrepare(mx, mx)
      ;  dim i
      ;  for (i=0;i<N_COLS(mx);i++)
         {  mclv* in = mx->cols+i
         ;  mclv* out = mclxVectorCompose(mx, in, NULL, ch)
         ;  mcldMinus(in, out, in)
         ;  mclvFree(&out)
      ;  }
         mclxWrite(mx, xfdagreduce, MCLXIO_VALUE_GETENV, EXIT_ON_FAIL)
      ;  mclxComposeRelease(&ch)
   ;  }

      else if (xfdiff)
      dag_diff_select(mx, tab, xfdiff, child_diff_lq, parent_diff_gq)

   ;  mclxFree(&mx)
   ;  mcxIOfree(&xfimx)
   ;  mcxIOfree(&xfdag)
   ;  mcxIOfree(&xfattr)
   ;  mcxIOfree(&xfdagreduce)
   ;  return 0
;  }
Beispiel #10
0
static dim clm_clm_prune
(  mclx*    mx
,  mclx*    cl
,  dim      prune_sz
,  mclx**   cl_adjustedpp
,  dim*     n_sink
,  dim*     n_source
)
   {  dim d, n_adjusted = 0
   ;  mclx* cl_adj = mclxCopy(cl)
   ;  mclv* cid_affected = mclvClone(cl->dom_cols)
   ;  const char* me = "clmAssimilate"

   ;  double bar_affected = 1.5

   ;  mclx *el_to_cl = NULL
   ;  mclx *el_on_cl = NULL
   ;  mclx *cl_on_cl = NULL
   ;  mclx *cl_on_el = NULL

   ;  *n_sink = 0
   ;  *n_source = 0

   ;  mclvMakeConstant(cid_affected, 1.0)
   ;  mclxColumnsRealign(cl_adj, mclvSizeCmp)

   ;  *cl_adjustedpp = NULL

   ;  clmCastActors
      (&mx, &cl_adj, &el_to_cl, &el_on_cl, &cl_on_cl, &cl_on_el, 0.95)
   ;  mclxFree(&cl_on_el)

   ;  for (d=0;d<N_COLS(cl_on_cl);d++)
      {  mclv* clthis   =  cl_adj->cols+d
      ;  mclv* cllist   =  cl_on_cl->cols+d
      ;  mclp* pself    =  mclvGetIvp(cllist, clthis->vid, NULL)
      ;  double self_val = -1.0
      
      ;  if (pself)
            self_val = pself->val
         ,  pself->val *= 1.001  /* to push it up in case of equal weights */

;if(0)fprintf(stderr, "test size %d\n", (int) clthis->n_ivps)
      ;  if (prune_sz && clthis->n_ivps > prune_sz)
         continue

      ;  while (1)
         {  mclv* clthat
         ;  dim e
         ;  if (cllist->n_ivps < 2)
            break
         ;  mclvSort(cllist, mclpValRevCmp)

                     /* now get biggest mass provided that cluster
                      * ranks higher (has at least as many entries)
                      *
                      * fixme/todo: we probably have a slight order
                      * dependency for some fringe cases. If provable
                      * then either solve or document it.
                     */
         ;  for (e=0;e<cllist->n_ivps;e++)
            if (cllist->ivps[e].idx >= clthis->vid)
            break

                     /* found none or itself */
         ;  if (e == cllist->n_ivps || cllist->ivps[e].idx == clthis->vid)
            break

         ;  if       /* Should Not Happen */
            (!(clthat
            =  mclxGetVector(cl_adj, cllist->ivps[e].idx, RETURN_ON_FAIL, NULL)
            ) )
            break

                     /*    works for special case prune_sz == 0               */
                     /*    if (clthat->n_ivps + clthis->n_ivps > prune_sz)    */
                     /*    ^iced. inconsistent behaviour as k grows.          */
         ;  {  mcxLog
               (  MCX_LOG_LIST
               ,  me
               ,  "source %ld|%lu|%.3f absorbed by %ld|%lu|%.3f"
               ,  clthis->vid, (ulong) clthis->n_ivps, self_val
               ,  clthat->vid, (ulong) clthat->n_ivps, cllist->ivps[0].val
               )
            ;  n_adjusted += clthis->n_ivps
            ;  (*n_sink)++
                     /* note: we could from our precomputed cl_on_cl
                      * obtain that A is absorbed in B, B is absorbed in C.
                      * below we see that A will be merged with B,
                      * and the result will then be merged with C.
                      * This depends on the fact that cl_adj is ordered
                      * on increasing cluster size.
                     */
            ;  mcldMerge(cl_adj->cols+d, clthat, clthat)
            ;  mclvResize(cl_adj->cols+d, 0)
            ;  mclvInsertIdx(cid_affected, clthat->vid, 2.0)
         ;  }
            break
      ;  }
         mclvSort(cllist, mclpIdxCmp)
   ;  }

      mclxFree(&cl_on_cl)
   ;  mclxFree(&el_on_cl)
   ;  mclxFree(&el_to_cl)

   ;  mclxMakeCharacteristic(cl)

   ;  mclvUnary(cid_affected, fltxGT, &bar_affected)
   ;  *n_source = cid_affected->n_ivps
   ;  mclvFree(&cid_affected)

   ;  mclxColumnsRealign(cl_adj, mclvSizeRevCmp)

   ;  if (!n_adjusted)
      {  mclxFree(&cl_adj)
      ;  return 0
   ;  }

      mclxUnary(cl_adj, fltxCopy, NULL)
   ;  mclxMakeCharacteristic(cl_adj)   

   ;  *cl_adjustedpp  =  cl_adj
   ;  return n_adjusted
;  }
Beispiel #11
0
dim clmAdjust
(  mclx* mx
,  mclx* cl
,  dim cls_size_max
,  mclx** cl_adjustedpp
,  mclv** ls_adjustedpp    /* nodes that moved around */
,  dim*  sjd_left
,  dim*  sjd_right
)
   {  dim sum_adjusted = 0, n_ite = 0
   ;  dim dist_curr_adj = 0, dist_adj_curr = 0
   ;  mclx* cl_adj = NULL
   ;  mclx* cl_curr = cl
   ;  mclv* ls_adjusted = mclvInit(NULL)
   ;  clmXScore score_curr, score_adj
   ;  const char* me = "clmAdjust"

   ;  *cl_adjustedpp = NULL
   ;  *ls_adjustedpp = NULL

   ;  while (1)
      {  dim n_adjusted
      ;  double cov_curr, cov_adj, frac_curr = 0.0, frac_adj = 0.0
      ;  mclv* cid_affected = NULL, *nid_affected = NULL
      ;  dim o, m, e

      ;  if (n_ite++ >= 100)
         break

      ;  mclxColumnsRealign(cl_curr, mclvSizeCmp)

      ;  if
         ( !(n_adjusted
         =   clm_clm_adjust
             (mx, cl_curr, cls_size_max, &cl_adj, &cid_affected, &nid_affected)
            )
         )
         break

      ;  mcxTell
         (  me
         ,  "assembled %lu nodes with %lu clusters affected"
         ,  (ulong) n_adjusted
         ,  (ulong) cid_affected->n_ivps
         )

      ;  clmXScanInit(&score_curr)
      ;  clmXScanInit(&score_adj)

      ;  clmXScanDomainSet(mx, cl_curr,cid_affected, &score_curr)
      ;  clmXScanDomainSet(mx, cl_adj, cid_affected, &score_adj)

      ;  clmXScoreCoverage(&score_curr, &cov_curr, NULL)
      ;  clmXScoreCoverage(&score_adj , &cov_adj , NULL)

      ;  if (score_curr.n_hits && score_adj.n_hits)
            frac_curr = score_curr.sum_i / score_curr.n_hits
         ,  frac_adj  = score_adj.sum_i  / score_adj.n_hits

      ;  mcxLog
         (  MCX_LOG_LIST
         ,  me
         ,  "consider (%.5f|%.5f|%lu) vs (%.5f|%.5f|%lu)"
         ,  cov_adj, frac_adj, (ulong) score_adj.n_hits
         ,  cov_curr, frac_curr, (ulong) score_curr.n_hits
         )
                           /* experience tells us that mcl's funneling
                            * worsens frac
                           */
      ;  if (frac_adj <=  frac_curr)
         {  mclvFree(&cid_affected)
         ;  mclvFree(&nid_affected)
         ;  break
      ;  }
         
         clmEnstrict(cl_adj, &o, &m, &e, 0)
      ;  clmSJDistance(cl_curr, cl_adj, NULL, NULL, &dist_curr_adj, &dist_adj_curr)

      ;  mcxLog
         (  MCX_LOG_AGGR
         ,  me
         ,  "distance %lu|%lu"
         ,  (ulong) dist_curr_adj, (ulong) dist_adj_curr
         )

      ;  mclvAdd(ls_adjusted, nid_affected, ls_adjusted)

      ;  if (cl_curr != cl)
         mclxFree(&cl_curr)

      ;  cl_curr = cl_adj
      ;  sum_adjusted += n_adjusted

      ;  mclvFree(&cid_affected)
      ;  mclvFree(&nid_affected)
   ;  }

      if (cl_curr != cl)            /* fixme free logic */
      {  mclxColumnsRealign(cl_curr, mclvSizeRevCmp)
      ;  *cl_adjustedpp = cl_curr
      ;  *ls_adjustedpp = ls_adjusted
      ;  clmSJDistance
         (cl, cl_curr, NULL, NULL, &dist_curr_adj, &dist_adj_curr)
      ;  if (sjd_left)
            *sjd_left  = dist_curr_adj
         ,  *sjd_right = dist_adj_curr
   ;  }
      else
      {  if (sjd_left)
            *sjd_left = 0
         ,  *sjd_right = 0
      ;  mclvFree(&ls_adjusted)
   ;  }

      mcxLog
      (  MCX_LOG_AGGR
      ,  me
      ,  "total adjusted %lu, final distance %lu|%lu"
      ,  (ulong) sum_adjusted 
      ,  (ulong) dist_curr_adj
      ,  (ulong) dist_adj_curr
      )

   ;  mclxColumnsRealign(cl, mclvSizeRevCmp)
   ;  return sum_adjusted
;  }
Beispiel #12
0
static dim clm_clm_adjust
(  mclx* mx
,  mclx* cl
,  dim cls_size_max
,  mclx** cl_adjustedpp
,  mclv** cid_affectedpp
,  mclv** nid_affectedpp
)
   {  dim i, j, n_adjusted = 0
   ;  mclx* cl_adj = mclxCopy(cl)

   ;  mclv* cid_affected = mclvClone(cl->dom_cols)
   ;  mclv* nid_affected = mclvClone(mx->dom_cols)
   ;  double bar_affected = 1.5

   ;  const char* e1 = getenv("MCL_ADJ_FMAX")
   ;  const char* e2 = getenv("MCL_ADJ_EMASS")
   
   ;  double f1 = e1 ? atof(e1) : 2
   ;  double f2 = e2 ? atof(e2) : 3

   ;  mcxbool loggit = mcxLogGet( MCX_LOG_CELL | MCX_LOG_INFO )

   ;  clmVScore sc

   ;  mclx *el_to_cl = NULL
   ;  mclx *el_on_cl = NULL
   ;  mclx *cl_on_cl = NULL
   ;  mclx *cl_on_el = NULL

   ;  *cl_adjustedpp = NULL
   ;  *cid_affectedpp = NULL
   ;  *nid_affectedpp = NULL

   ;  clmCastActors
      (&mx, &cl, &el_to_cl, &el_on_cl, &cl_on_cl, &cl_on_el, 0.95)

   ;  mclxFree(&cl_on_cl)
   ;  mclxFree(&cl_on_el)

   ;  mclvMakeConstant(cid_affected, 1.0)
   ;  mclvMakeConstant(nid_affected, 1.0)


   ;  for (i=0;i<N_COLS(cl_adj);i++)
      cl_adj->cols[i].val = 0.5

                     /*    Proceed with smallest clusters first.
                      *    Caller has to take care of mclxColumnsRealign
                     */
   ;  for (i=0;i<N_COLS(cl);i++)
      {  mclv* clself = cl->cols+i

                     /*    Only consider nodes in clusters of
                      *    size <= cls_size_max
                     */
      ;  if (cls_size_max && clself->n_ivps > cls_size_max)
         break
                     /*    Clusters that have been marked for inclusion
                      *    cannot play.
                     */
      ;  if (cl_adj->cols[i].val > 1)
         continue

      ;  for (j=0;j<clself->n_ivps;j++)
         {  long nid  = clself->ivps[j].idx
         ;  long nos  = mclvGetIvpOffset(mx->dom_cols, nid, -1)
         ;  mclv* clidvec  =  mclxGetVector(el_on_cl, nid, RETURN_ON_FAIL, NULL)

         ;  double eff_alien_bsf = 0.0, eff_alien_max_bsf = 0.0 /* best so far*/
         ;  double eff_self = 0.0, eff_self_max = 0.0
         ;  long cid_alien  = -1, cid_self = -1
         ;  clmVScore sc_self = { 0 }, sc_alien = { 0 }
         ;  dim f

         ;  if (nos < 0 || !clidvec)
            {  mcxErr
               ("clmDumpNodeScores panic", "node <%ld> does not belong", nid)
            ;  continue
         ;  }

            clmVScanDomain(mx->cols+nos, clself, &sc)
         ;  clmVScoreCoverage(&sc, &eff_self, &eff_self_max)
         ;  cid_self = clself->vid
         ;  sc_self  = sc

         ;  if (loggit)
            mcxLog2
            (  us
            ,  "node %ld in cluster %ld eff %.3f,%.3f sum %.3f"
            ,  nid
            ,  cid_self
            ,  eff_self
            ,  eff_self_max
            ,  sc.sum_i
            )

         ;  for (f=0;f<clidvec->n_ivps;f++)
            {  long cid = clidvec->ivps[f].idx
            ;  mclv* clvec = mclxGetVector(cl, cid, RETURN_ON_FAIL, NULL)
                          /* ^ overdoing: cid == clvec->vid */
            ;  double eff, eff_max
            ;  if (!clvec)
               {  mcxErr
                  (  "clmAdjust panic"
                  ,  "cluster <%ld> node <%ld> mishap"
                  ,  cid
                  ,  nid
                  )
               ;  continue
            ;  }


                        /* fixme: document or remove first condition
                         *
                        */
               if ((0 && clvec->n_ivps <= clself->n_ivps) || clvec->vid == cid_self)
               continue

            ;  clmVScanDomain(mx->cols+nos, clvec, &sc)
            ;  clmVScoreCoverage(&sc, &eff, &eff_max)

#if 0
#  define PIVOT eff > eff_alien_bsf
#else
#  define PIVOT eff_max > eff_alien_max_bsf
#endif

            ;  if
               (  PIVOT
               || sc.sum_i >= 0.5
               )
                  eff_alien_bsf = eff
               ,  eff_alien_max_bsf = eff_max
               ,  cid_alien = clvec->vid
               ,  sc_alien = sc

            ;  if (sc.sum_i >= 0.5)
               break
         ;  }

            if (loggit)
            mcxLog2
            (  us
            ,  " -> best alien %ld eff %.3f,%.3f sum %.3f"
            ,  cid_alien
            ,  eff_alien_bsf
            ,  eff_alien_max_bsf
            ,  sc_alien.sum_i
            )

                  /* below: use sum_i as mass fraction
                   * (clmAdjust framework uses stochastic * matrix)
                  */
         ;  if
            (  cid_alien >= 0
            && cid_self >= 0
            && f1 * sc_alien.max_i >= sc_self.max_i
            && (  (  eff_alien_bsf > eff_self
                  && sc_alien.sum_i > sc_self.sum_i
                  )
               || (  pow(sc_alien.sum_i, f2) >= sc_self.sum_i
                  && pow(eff_self, f2) <= eff_alien_bsf
                  )
               )
                  /* So, if max is reasonable
                   * and efficiency is better and mass is better
                   * or if mass is ridiculously better -> move
                   * Somewhat intricate and contrived, yes.
                  */
            )
            {  mclv* acceptor
               =  mclxGetVector(cl_adj, cid_alien, RETURN_ON_FAIL, NULL)
            ;  mclv* donor
               =  mclxGetVector(cl_adj, cid_self,  RETURN_ON_FAIL, NULL)
            ;  if (!donor || !acceptor || acceptor == donor)
               continue

            ;  mclvInsertIdx(donor, nid, 0.0)
            ;  mclvInsertIdx(acceptor, nid, 1.0)
            ;  acceptor->val = 1.5

            ;  if (mcxLogGet(MCX_LOG_LIST))
               {  mclv* nb = mx->cols+nos
               ;  double mxv = mclvMaxValue(nb)
               ;  double avg = nb->n_ivps ? mclvSum(nb) / nb->n_ivps : -1.0
               ;  mcxLog
                  (  MCX_LOG_LIST
                  ,  us
                  ,  "mov %ld (%ld %.2f %.2f)"
                     " %ld (cv=%.2f cm=%.2f s=%.2f m=%.2f #=%lu)"
                     " to %ld (cv=%.2f cm=%.2f s=%.2f m=%.2f #=%lu)"
                  ,  nid
                  ,     (long) nb->n_ivps, mxv, avg
                  ,  cid_self
                  ,     eff_self, eff_self_max, sc_self.sum_i, sc_self.max_i
                  ,              (ulong) (sc_self.n_meet + sc_self.n_ddif)
                  ,  cid_alien
                  ,     eff_alien_bsf, eff_alien_max_bsf, sc_alien.sum_i, sc_alien.max_i
                  ,              (ulong) (sc_alien.n_meet + sc_alien.n_ddif)
                  )
            ;  }

               n_adjusted++                  
            ;  mclvInsertIdx(cid_affected, cid_alien, 2.0)
            ;  mclvInsertIdx(cid_affected, cid_self, 2.0)
            ;  mclvInsertIdx(nid_affected, nid, 2.0)
         ;  }
         }
      }
      mclxFree(&el_on_cl)
   ;  mclxFree(&el_to_cl)

   ;  for (i=0;i<N_COLS(cl_adj);i++)
      cl_adj->cols[i].val = 0.0

   ;  mclxMakeCharacteristic(cl)

   ;  if (!n_adjusted)
      {  mclxFree(&cl_adj)
      ;  mclvFree(&cid_affected)
      ;  mclvFree(&nid_affected)
      ;  return 0
   ;  }

      mclxUnary(cl_adj, fltxCopy, NULL)
   ;  mclxMakeCharacteristic(cl_adj)   
                     /* FIRST REMOVE ENTRIES set to zero (sssst now .. */
                     /* ...) and THEN make it characteristic again     */

   ;  mclvUnary(cid_affected, fltxGT, &bar_affected)
   ;  mclvUnary(nid_affected, fltxGT, &bar_affected)

   ;  *cl_adjustedpp  =  cl_adj
   ;  *cid_affectedpp =  cid_affected
   ;  *nid_affectedpp =  nid_affected

   ;  return n_adjusted
;  }
Beispiel #13
0
         /* this aids in finding heuristically likely starting points
          * for long shortest paths, by looking at dead ends
          * in the lattice.
          * experimental, oefully underdocumented.
         */
static dim diameter_rough
(  mclv*       vec
,  mclx*       mx
,  u8*         rough_scratch
,  long*       rough_priority
)
   {  mclv* curr  =  mclvInsertIdx(NULL, vec->vid, 1.0) 
   ;  mclpAR* par =  mclpARensure(NULL, 1024)

   ;  dim d = 0, n_dead_ends = 0, n_dead_ends_res = 0

   ;  memset(rough_scratch, 0, N_COLS(mx))

   ;  rough_scratch[vec->vid] = 1                        /* seen */
   ;  rough_priority[vec->vid] = -1              /* remove from priority list */

   ;  while (1)
      {  mclp* currivp = curr->ivps
      ;  dim t
      ;  mclpARreset(par)
      ;  while (currivp < curr->ivps + curr->n_ivps)
         {  mclv* ls = mx->cols+currivp->idx
         ;  mclp* newivp = ls->ivps
         ;  int hit = 0
         ;  while (newivp < ls->ivps + ls->n_ivps)
            {  u8* tst = rough_scratch+newivp->idx
            ;  if (!*tst || *tst & 2)
               {  if (!*tst)
                  mclpARextend(par, newivp->idx, 1.0)
               ;  *tst = 2
               ;  hit = 1
            ;  }
               newivp++
         ;  }
            if (!hit && rough_priority[currivp->idx] >= 0)
               rough_priority[currivp->idx] += d+1
            ,  n_dead_ends_res++
         ;  else if (!hit)
            n_dead_ends++
/* ,fprintf(stderr, "[%ld->%ld]", (long) currivp->idx, (long) rough_priority[currivp->idx])
*/
;
#if 0
if (currivp->idx == 115 || currivp->idx == 128)
fprintf(stdout, "pivot %d node %d d %d dead %d pri %d\n", (int) vec->vid, (int) currivp->idx, d, (int) (1-hit), (int) rough_priority[currivp->idx])
#endif
         ;  currivp++
      ;  }
         if (!par->n_ivps)
         break
      ;  d++
      ;  mclvFromIvps(curr, par->ivps, par->n_ivps)
      ;  for (t=0;t<curr->n_ivps;t++)
         rough_scratch[curr->ivps[t].idx] = 1
   ;  }

      mclvFree(&curr)
   ;  mclpARfree(&par)
;if(0)fprintf(stdout, "deadends %d / %d\n", (int) n_dead_ends, (int) n_dead_ends_res)
   ;  return d
;  }
Beispiel #14
0
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
;  }