Esempio n. 1
0
static void erdos_link_together
(  mcxIO* xfout
,  mclx* mx
,  mclv* tails
,  mclv* heads
)
   {  dim v = 0
   ;  mclv* relevant = mclvInit(NULL)
   ;  fprintf(xfout->fp, "(");
   ;  for (v=0;v<tails->n_ivps;v++)
      {  long t = tails->ivps[v].idx
      ;  dim j
      ;  mclv* nb = mclxGetVector(mx, t, EXIT_ON_FAIL, NULL)
      ;  mcldMeet(nb, heads, relevant)
      ;  for (j=0;j<relevant->n_ivps;j++)
         {  if (tab_g)
            {  long u = relevant->ivps[j].idx
            ;  const char* sx = mclTabGet(tab_g, (long) t, NULL)
            ;  const char* sy = mclTabGet(tab_g, (long) u, NULL)
            ;  if (!sx)
               sx = "NAx"
            ;  if (!sy)
               sy = "NAy"
            ;  fprintf(xfout->fp, " (%s %s)", sx, sy)
         ;  }
            else
            fprintf(xfout->fp, " (%ld %ld)", (long) t, (long) relevant->ivps[j].idx)
      ;  }
         if (!relevant->n_ivps)
         mcxErr(me, "odd, %d has no friends\n", (int) t)
   ;  }
      fprintf(xfout->fp, " )\n");
   ;  mclvFree(&relevant)
;  }
Esempio n. 2
0
mcxstatus fire_node_next
(  const mclx* mx
,  mclv* seen
,  mclv *todo
,  dim start
)
   {  mclv* next = mclvInit(NULL)
   ;  dim i
   ;  mcxstatus s = STATUS_OK
;if(0)fprintf(stderr, "\tnext layer has %d nodes\n", (int) todo->n_ivps)
   ;  for (i=0; i<todo->n_ivps;i++)
      {  mclv* ls = mclxGetVector(mx, todo->ivps[i].idx, RETURN_ON_FAIL, NULL)
      ;  if (ls)
         {  mcldMerge(next, ls, next)
         ;  if (mclvGetIvp(ls, start, NULL))
            {  s = STATUS_FAIL
            ;  break
         ;  }
         }
      }
      mcldMerge(seen, todo, seen)      /* add todo to seen */
   ;  mcldMinus(next, seen, next)      /* remove seen from next */
   ;  mclvCopy(todo, next)             /* copy next to todo */
   ;  mclvFree(&next)
   ;  return s
;  }
Esempio n. 3
0
mclVector* mclvInstantiate
(  mclVector*     dst_vec
,  dim            new_n_ivps
,  const mclIvp*  src_ivps
)
   {  mclIvp*     new_ivps
   ;  dim         old_n_ivps

   ;  if (!dst_vec && !(dst_vec = mclvInit(NULL)))    /* create */
      return NULL

   ;  old_n_ivps = dst_vec->n_ivps

                                    /* I've had a suspicion that some reallocs might be too lazy
                                     * to reuse shrunk array space.
                                    */
   ;  if (old_n_ivps / 2 > new_n_ivps)
      {  new_ivps = mcxAlloc(new_n_ivps * sizeof new_ivps[0], ENQUIRE_ON_FAIL)
      ;  if (new_ivps && !src_ivps)
         memcpy(new_ivps, dst_vec->ivps, new_n_ivps * sizeof new_ivps[0])
      ;  mcxFree(dst_vec->ivps)
      ;  dst_vec->ivps = new_ivps
   ;  }
      else
      dst_vec->ivps =  mcxRealloc(dst_vec->ivps, new_n_ivps * sizeof new_ivps[0], ENQUIRE_ON_FAIL)

   ;  if 
      (  !dst_vec->ivps
      && new_n_ivps
      )
      {  mcxMemDenied(stderr, "mclvInstantiate", "mclIvp", new_n_ivps)
      ;  return NULL
   ;  }
                                      /*  ^ do not free; *dst_vec could be array element */

      new_ivps = dst_vec->ivps

   ;  if (!src_ivps)                                  /* resize */
      {  dim k = old_n_ivps
      ;  while (k < new_n_ivps)
         {  mclpInit(new_ivps + k)
         ;  k++
      ;  }
      }
      else if (src_ivps && new_n_ivps)                /* copy   */
      memcpy(new_ivps, src_ivps, new_n_ivps * sizeof(mclIvp))

   ;  dst_vec->n_ivps = new_n_ivps
   ;  return dst_vec
;  }
Esempio n. 4
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
;  }
Esempio n. 5
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)
;  }
Esempio n. 6
0
int main
(  int                  argc
,  const char*          argv[]
)
   {  mcxIO* xf_tab     =  NULL
   ;  mcxIO* xf_tabr    =  NULL
   ;  mcxIO* xf_tabc    =  NULL
   ;  mcxIO* xf_restrict_tab     =  NULL
   ;  mcxIO* xf_restrict_tabr    =  NULL
   ;  mcxIO* xf_restrict_tabc    =  NULL
   ;  mcxIO* xf_mx      =  mcxIOnew("-", "r")
   ;  mcxIO* xfout    =  NULL
   ;  const char*  fndump  =  "-"
   ;  mclTab* tabr      =  NULL
   ;  mclTab* tabc      =  NULL
   ;  mclTab* restrict_tabr =  NULL
   ;  mclTab* restrict_tabc =  NULL
   ;  mcxbool transpose =  FALSE
   ;  mcxbool lazy_tab  =  FALSE
   ;  mcxbool write_tabc =  FALSE
   ;  mcxbool write_tabr =  FALSE
   ;  mcxbool cat       =  FALSE
   ;  mcxbool tree      =  FALSE
   ;  mcxbool skel      =  FALSE
   ;  mcxbool newick    =  FALSE
   ;  mcxbits newick_bits = 0
   ;  mcxbits cat_bits  =  0
   ;  dim catmax        =  1
   ;  dim n_max         =  0
   ;  dim table_nlines  =  0
   ;  dim table_nfields =  0
   ;  int split_idx     =  1
   ;  int split_inc     =  1
   ;  const char* split_stem =  NULL
   ;  const char* sort_mode = NULL
   ;  mcxTing* line     =  mcxTingEmpty(NULL, 10)

   ;  mcxbits modes     =  MCLX_DUMP_VALUES

   ;  mcxbits mode_dump =  MCLX_DUMP_PAIRS
   ;  mcxbits mode_part =  0
   ;  mcxbits mode_loop =  MCLX_DUMP_LOOP_ASIS
   ;  mcxbits mode_matrix = 0
   ;  int digits        =  MCLXIO_VALUE_GETENV

   ;  mcxOption* opts, *opt
   ;  mcxstatus parseStatus = STATUS_OK

   ;  mcxLogLevel =
      MCX_LOG_AGGR | MCX_LOG_MODULE | MCX_LOG_IO | MCX_LOG_GAUGE | MCX_LOG_WARN
   ;  mclxIOsetQMode("MCLXIOVERBOSITY", MCL_APP_VB_YES)
   ;  mclx_app_init(stderr)
   
   ;  mcxOptAnchorSortById(options, sizeof(options)/sizeof(mcxOptAnchor) -1)
   ;  opts = mcxOptParse(options, (char**) argv, argc, 1, 0, &parseStatus)

   ;  if (!opts)
      exit(0)

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

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

            case MY_OPT_VERSION
         :  app_report_version(me)
         ;  return 0
         ;

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

            case MY_OPT_TABC
         :  xf_tabc = mcxIOnew(opt->val, "r")
         ;  break
         ;

            case MY_OPT_TABR
         :  xf_tabr = mcxIOnew(opt->val, "r")
         ;  break
         ;

            case MY_OPT_OUTPUT
         :  fndump = opt->val
         ;  break
         ;

            case MY_OPT_SEP_LEAD
         :  sep_lead_g = opt->val
         ;  break
         ;

            case MY_OPT_SEP_FIELD
         :  sep_row_g = opt->val
         ;  break
         ;

            case MY_OPT_SEP_CAT
         :  sep_cat_g = opt->val
         ;  break
         ;

            case MY_OPT_SEP_VAL
         :  sep_val_g = opt->val
         ;  break
         ;

            case MY_OPT_PREFIXC
         :  prefixc_g = opt->val
         ;  break
         ;

            case MY_OPT_RESTRICT_TAB
         :  xf_restrict_tab = mcxIOnew(opt->val, "r")
         ;  break
         ;

            case MY_OPT_RESTRICT_TABC
         :  xf_restrict_tabc = mcxIOnew(opt->val, "r")
         ;  break
         ;

            case MY_OPT_RESTRICT_TABR
         :  xf_restrict_tabr = mcxIOnew(opt->val, "r")
         ;  break
         ;

            case MY_OPT_LAZY_TAB
         :  lazy_tab = TRUE
         ;  break
         ;

            case MY_OPT_NO_VALUES
         :  BIT_OFF(modes, MCLX_DUMP_VALUES)
         ;  break
         ;

            case MY_OPT_DUMP_RLINES
         :  mode_dump = MCLX_DUMP_LINES
         ;  BIT_ON(modes, MCLX_DUMP_NOLEAD)
         ;  break
         ;

            case MY_OPT_DUMP_VLINES
         :  mode_dump = MCLX_DUMP_LINES
         ;  BIT_ON(modes, MCLX_DUMP_LEAD_VALUE)
         ;  break
         ;

            case MY_OPT_DUMP_LINES
         :  mode_dump = MCLX_DUMP_LINES
         ;  break
         ;

            case MY_OPT_OMIT_EMPTY
         :  BIT_ON(modes, MCLX_DUMP_OMIT_EMPTY)
         ;  break
         ;

            case MY_OPT_SORT
         :  sort_mode = opt->val
         ;  break
         ;

            case MY_OPT_NO_LOOPS
         :  mode_loop = MCLX_DUMP_LOOP_NONE
         ;  break
         ;

            case MY_OPT_CAT_LIMIT
         :  n_max = atoi(opt->val)
         ;  break
         ;

            case MY_OPT_SPLIT_STEM
         :  split_stem = opt->val
         ;  sep_cat_g = NULL
         ;  break
         ;

            case MY_OPT_FORCE_LOOPS
         :  mode_loop = MCLX_DUMP_LOOP_FORCE
         ;  break
         ;

            case MY_OPT_SKEL
         :  skel = TRUE
         ;  break
         ;

            case MY_OPT_WRITE_TABC
         :  write_tabc = TRUE
         ;  break
         ;

            case MY_OPT_DIGITS
         :  digits = strtol(opt->val, NULL, 10)
         ;  break
         ;

            case MY_OPT_WRITE_TABR
         :  write_tabr = TRUE
         ;  break
         ;

            case MY_OPT_DUMP_RDOM
         :  transpose = TRUE
         ;  skel = TRUE
         ;  mode_dump = MCLX_DUMP_LINES
         ;  break
         ;

            case MY_OPT_DUMP_CDOM
         :  skel = TRUE
         ;  mode_dump = MCLX_DUMP_LINES
         ;  break
         ;

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

            case MY_OPT_ICL
         :  mcxIOnewName(xf_mx, opt->val)
         ;  mode_dump = MCLX_DUMP_LINES
         ;  BIT_ON(modes, MCLX_DUMP_NOLEAD)
         ;  BIT_OFF(modes, MCLX_DUMP_VALUES)
         ;  break
         ;

            case MY_OPT_TREECAT
         :  mcxIOnewName(xf_mx, opt->val)
         ;  tree = TRUE
         ;  cat_bits |= MCLX_PRODUCE_DOMSTACK
         ;  break
         ;

            case MY_OPT_CAT
         :  mcxIOnewName(xf_mx, opt->val)
         ;  cat = TRUE
         ;  break
         ;

            case MY_OPT_DUMP_MATRIX
         :  mode_matrix |= MCLX_DUMP_MATRIX
         ;  break
         ;

            case MY_OPT_TRANSPOSE
         :  transpose = TRUE
         ;  break
         ;

            case MY_OPT_DUMP_UPPER
         :  mode_part = MCLX_DUMP_PART_UPPER
         ;  break
         ;

            case MY_OPT_DUMP_UPPERI
         :  mode_part = MCLX_DUMP_PART_UPPERI
         ;  break
         ;

            case MY_OPT_DUMP_LOWER
         :  mode_part = MCLX_DUMP_PART_LOWER
         ;  break
         ;

            case MY_OPT_DUMP_LOWERI
         :  mode_part = MCLX_DUMP_PART_LOWERI
         ;  break
         ;

            case MY_OPT_DUMP_NOLEAD
         :  BIT_ON(modes, MCLX_DUMP_NOLEAD)
         ;  break
         ;

            case MY_OPT_NEWICK_MODE
         :  if (strchr(opt->val, 'N'))
            newick_bits |= (MCLX_NEWICK_NONL | MCLX_NEWICK_NOINDENT)
         ;  if (strchr(opt->val, 'I'))
            newick_bits |= MCLX_NEWICK_NOINDENT
         ;  if (strchr(opt->val, 'B'))
            newick_bits |= MCLX_NEWICK_NONUM
         ;  if (strchr(opt->val, 'S'))
            newick_bits |= MCLX_NEWICK_NOPTHS
         ;  newick = TRUE
         ;  break
         ;

            case MY_OPT_DUMP_NEWICK
         :  newick = TRUE
         ;  break
         ;

            case MY_OPT_DUMP_TABLE
         :  mode_dump = MCLX_DUMP_TABLE
         ;  break
         ;

            case MY_OPT_TABLE_NFIELDS
         :  table_nfields = atoi(opt->val)
         ;  break
         ;

            case MY_OPT_TABLE_NLINES
         :  table_nlines = atoi(opt->val)
         ;  break
         ;

            case MY_OPT_DUMP_PAIRS
         :  mode_dump = MCLX_DUMP_PAIRS
         ;  break
      ;  }
      }

   ;  if (skel)
      cat_bits |= MCLX_READ_SKELETON

   ;  modes |= mode_loop | mode_dump | mode_part | mode_matrix

   ;  xfout = mcxIOnew(fndump, "w")
   ;  mcxIOopen(xfout, EXIT_ON_FAIL)

   ;  mcxIOopen(xf_mx, EXIT_ON_FAIL)

   ;  if (cat || tree)
      catmax = n_max ? n_max : 0

   ;  if ((write_tabc || write_tabr) && !xf_tab)
      mcxDie(1, me, "need a single tab file (-tab option) with --write-tabc or --write-tabr")

   ;  if (xf_tab && mcxIOopen(xf_tab, RETURN_ON_FAIL))
      mcxDie(1, me, "no tab")
   ;  else
      {  if (xf_tabr && mcxIOopen(xf_tabr, RETURN_ON_FAIL))
         mcxDie(1, me, "no tabr")
      ;  if (xf_tabc && mcxIOopen(xf_tabc, RETURN_ON_FAIL))
         mcxDie(1, me, "no tabc")
   ;  }

      {  if (xf_restrict_tab && mcxIOopen(xf_restrict_tab, RETURN_ON_FAIL))
         mcxDie(1, me, "no restriction tab")
      ;  else
         {  if (xf_restrict_tabr && mcxIOopen(xf_restrict_tabr, RETURN_ON_FAIL))
            mcxDie(1, me, "no restriction tabr")
         ;  if (xf_restrict_tabc && mcxIOopen(xf_restrict_tabc, RETURN_ON_FAIL))
            mcxDie(1, me, "no restriction tabc")
      ;  }
                              /* fixme: below is pretty boilerplate, happens in other places as well */
         if (xf_restrict_tab)
         {  if (!(restrict_tabr = mclTabRead (xf_restrict_tab, NULL, RETURN_ON_FAIL)))
            mcxDie(1, me, "error reading restriction tab")
         ;  restrict_tabc = restrict_tabr
         ;  mcxIOclose(xf_restrict_tab)
      ;  }
         else
         {  if (xf_restrict_tabr)
            {  if (!(restrict_tabr = mclTabRead(xf_restrict_tabr, NULL, RETURN_ON_FAIL)))
               mcxDie(1, me, "error reading restriction tabr")
            ;  mcxIOclose(xf_restrict_tabr)
         ;  }
            if (xf_restrict_tabc)
            {  if (!(restrict_tabc = mclTabRead(xf_restrict_tabc, NULL, RETURN_ON_FAIL)))
               mcxDie(1, me, "error reading restriction tabc")
            ;  mcxIOclose(xf_restrict_tabc)
         ;  }
         }
      }

                        /* fixme: restructure code to include bit below */

      if (write_tabc || write_tabr)
      {  mclv* dom_cols = mclvInit(NULL)
      ;  mclv* dom_rows = mclvInit(NULL)
      ;  mclv* dom = write_tabc ? dom_cols : dom_rows

      ;  if (!(tabc =  mclTabRead(xf_tab, NULL, RETURN_ON_FAIL)))
         mcxDie(1, me, "error reading tab file")

      ;  if (mclxReadDomains(xf_mx, dom_cols, dom_rows))
         mcxDie(1, me, "error reading matrix file")
      ;  mcxIOclose(xf_mx)

                                       /* fixme check status */
      ;  mclTabWrite(tabc, xfout, dom, RETURN_ON_FAIL) 

      ;  mcxIOclose(xfout)
      ;  return 0
   ;  }

      if (newick)
      {  mcxTing* thetree
      ;  mclxCat  cat

      ;  if (xf_tab && !(tabr =  mclTabRead(xf_tab, NULL, RETURN_ON_FAIL)))
         mcxDie(1, me, "error reading tab file")

      ;  mclxCatInit(&cat)

      ;  if
         (  mclxCatRead
            (  xf_mx
            ,  &cat
            ,  0
            ,  NULL
            ,  tabr ? tabr->domain : NULL
            ,  MCLX_CATREAD_CLUSTERTREE | MCLX_ENSURE_ROOT
            )
         )
         mcxDie(1, me, "failure reading file")
      ;  thetree = mclxCatNewick(&cat, tabr, newick_bits)
      ;  fwrite(thetree->str, 1, thetree->len, xfout->fp)
      ;  fputc('\n', xfout->fp)
      ;  mcxIOclose(xfout)
      ;  return 0
   ;  }

      while (1)
      {  mclxIOdumper dumper
      ;  mclxCat    cat
      ;  dim i

      ;  if (xf_tab && !lazy_tab)
         cat_bits |= MCLX_REQUIRE_GRAPH

      ;  mclxCatInit(&cat)

      ;  if (mclxCatRead(xf_mx, &cat, catmax, NULL, NULL, cat_bits))
         break

      ;  for (i=0;i<cat.n_level;i++)
         {  mclx* mx = cat.level[i].mx

         ;  if (restrict_tabr || restrict_tabc)
            {  mclx* sub
            ;  sub
               =  mclxSub
                  (  mx
                  ,  restrict_tabc
                     ?  restrict_tabc->domain
                     :  mx->dom_cols
                  ,  restrict_tabr
                     ?  restrict_tabr->domain
                     :  mx->dom_rows
                  )
            ;  mx = sub
         ;  }
            /* noteme fixme dangersign mx now may violate some 'cat' invariant */

            if (sort_mode)
            {  if (!strcmp(sort_mode, "size-ascending"))
               mclxColumnsRealign(mx, mclvSizeCmp)
            ;  else if (!strcmp(sort_mode, "size-descending"))
               mclxColumnsRealign(mx, mclvSizeRevCmp)
            ;  else
               mcxErr(me, "unknown sort mode <%s>", sort_mode)
            ;  if (catmax != 1)
               mcxErr(me, "-sort option and cat mode may fail or corrupt")
         ;  }

            if (xf_tab && !tabr)
            {  if (!(  tabr = mclTabRead
                       (xf_tab, lazy_tab ? NULL : mx->dom_rows, RETURN_ON_FAIL)
                  ) )
               mcxDie(1, me, "consider using --lazy-tab option")
            ;  tabc = tabr
            ;  mcxIOclose(xf_tab)
         ;  }
            else
            {  if (!tabr && xf_tabr)
               {  if (!(tabr =  mclTabRead
                        (xf_tabr, lazy_tab ? NULL : mx->dom_rows, RETURN_ON_FAIL)
                     ) )
                  mcxDie(1, me, "consider using --lazy-tab option")
               ;  mcxIOclose(xf_tabr)
            ;  }
               if (!tabc && xf_tabc)
               {  if (!( tabc = mclTabRead
                        (xf_tabc, lazy_tab ? NULL : mx->dom_cols, RETURN_ON_FAIL)
                     ) )
                  mcxDie(1, me, "consider using --lazy-tab option")
               ;  mcxIOclose(xf_tabc)
            ;  }
            }

         ;  if (transpose)
            {  mclx* tp = mclxTranspose(mx)
            ;  mclxFree(&mx)
            ;  mx = tp
            ;  if (tabc || tabr)
               {  mclTab* tabt = tabc
               ;  tabc = tabr
               ;  tabr = tabt
            ;  }
            }

            if (mode_dump == MCLX_DUMP_TABLE)
            BIT_ON(modes, MCLX_DUMP_TABLE_HEADER)

         ;  mclxIOdumpSet(&dumper, modes, sep_lead_g, sep_row_g, sep_val_g)
         ;  dumper.table_nlines  = table_nlines
         ;  dumper.table_nfields = table_nfields
         ;  dumper.prefixc = prefixc_g

         ;  if (split_stem)
            {  mcxTing* ting = mcxTingPrint(NULL, "%s.%03d", split_stem, split_idx)
            ;  mcxIOclose(xfout)
            ;  mcxIOrenew(xfout, ting->str, "w")
            ;  split_idx += split_inc
         ;  }

            if
            (  mclxIOdump
               (  mx
               ,  xfout
               ,  &dumper
               ,  tabc
               ,  tabr
               ,  digits
               ,  RETURN_ON_FAIL
             ) )
            mcxDie(1, me, "something suboptimal")

         ;  mclxFree(&mx)

         ;  if (sep_cat_g && i+1 < cat.n_level)
            fprintf(xfout->fp, "%s\n", sep_cat_g)
      ;  }
         break
   ;  }

      mcxIOfree(&xf_mx)
   ;  mcxIOfree(&xfout)
   ;  mcxIOfree(&xf_tab)
   ;  mcxIOfree(&xf_tabr)
   ;  mcxIOfree(&xf_tabc)
   ;  mcxTingFree(&line)
   ;  return 0
;  }
Esempio n. 7
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
;  }