/* returns number of elements in src not found in dst */ dim mclvEmbed ( mclv* dst , const mclv* src , double val ) { mclIvp* ivp ; dim d = 0 ; dim n_notfound = 0 /* set everything to val */ ; ivp = dst->ivps ; while (ivp < dst->ivps+dst->n_ivps) (ivp++)->val = val /* insert src values */ /* fixme: use better implementation, * preferably with a callback */ ; ivp = dst->ivps ; for (d=0;d<src->n_ivps;d++) { ivp = mclvGetIvp(dst, src->ivps[d].idx, ivp) ; if (ivp) ivp->val = src->ivps[d].val ; else n_notfound++ ; } return n_notfound ; }
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 ; }
int mclDagTest ( const mclMatrix* dag ) { mclv* v_transient = mclvCopy(NULL, dag->dom_cols) ; mclx* m_transient = NULL ; int maxdepth = 0 ; dim d ; mclvMakeCharacteristic(v_transient) ; for (d=0;d<N_COLS(dag);d++) { mclv* col = dag->cols+d ; if (mclvGetIvp(col, col->vid, NULL)) /* deemed attractor */ mclvInsertIdx(v_transient, col->vid, 0.25) ; } mclvSelectGqBar(v_transient, 0.5) ; m_transient = mclxSub(dag, v_transient, v_transient) ;if(0)mclxDebug("-", m_transient, 3, "transient") ; maxdepth = calc_depth(m_transient) ; mclxFree(&m_transient) ; mclvFree(&v_transient) ; return maxdepth ; }
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 ; }
mcxstatus mclvReplaceIdx ( mclVector* vec , long ofs , long idx , double val ) { mclp piv, *dst ; if (!vec || ofs < 0 || vec->n_ivps <= (dim) ofs) return STATUS_FAIL ; if (mclvGetIvp(vec, idx, NULL)) return STATUS_FAIL ; piv.idx = idx ; piv.val = val /* a b c d _ f g h i * e will go; * idx needs to be somewhere in the f-i range. If i needs * to go then we have * a b c d e f g h _ * then (vec->ivps+ofs+1) == dst == vec->ivps+vec->n_ivps * and the size to copy is zero. */ ; if (vec->ivps[ofs].idx < idx) { if (!(dst = mclpBsearchCeil(&piv, vec->ivps, vec->n_ivps))) dst = vec->ivps+vec->n_ivps ; memmove ( vec->ivps+ofs /* destination */ , vec->ivps+ofs+1 /* source */ , sizeof piv * ((dst-(vec->ivps+ofs))-1) ) ; dst[-1] = piv ; } /* a b c d _ f g h i * e will go; * idx needs to be somewhere in the a-d range. If a * needs to go then we have * _ b c d e f g h i * then ofs == vec->ivps and dst == vec->ivps * and the size to copy is zero. */ else if (vec->ivps[ofs].idx > idx) { if (!(dst = mclpBsearchFloor(&piv, vec->ivps, vec->n_ivps))) dst = vec->ivps ; else dst++ ; memmove ( dst+1 /* destination */ , dst /* source */ , sizeof piv * (vec->ivps+ofs-dst) ) ; dst[0] = piv ; } return STATUS_OK ; }
ofs mclvGetIvpOffset ( const mclv* vec , long idx , ofs offset ) { mclIvp* match = mclvGetIvp ( vec , idx , offset >= 0 ? vec->ivps + offset : vec->ivps ) ; return match ? match - vec->ivps : -1 ; }
void dag_diff_select ( mclx* mx , mclTab* tab , mcxIO* xfdiff , double child_diff_lq , double parent_diff_gq ) { dim i ; mclx* dag = mclxAllocClone(mx) ; for (i=0;i<N_COLS(mx); i++) { mclv* v = mx->cols+i ; dim j ; for (j=0;j<v->n_ivps;j++) { dim idx = v->ivps[j].idx ; double valv = v->ivps[j].val ; mclv* t = mclxGetVector(mx, idx, EXIT_ON_FAIL, NULL) ; mclp* p = mclvGetIvp(t, v->vid, NULL) ; double valt = p ? p->val : 0.0 ; double delta = valv - valt ; double lg = valv, sm = valt ; double child_diff, parent_diff ; int v_is_child = 0 ; if (delta < 0) delta = -delta , lg=valt, sm=valv , v_is_child = 1 ; child_diff = sm ; parent_diff = lg ;if(0 && i==111) fprintf(stderr, "nb %d delta %g\n", (int) idx, delta) ; if (child_diff > child_diff_lq || parent_diff < parent_diff_gq) NOTHING ; else { if (v_is_child) mclvInsertIdx(dag->cols+i, idx, delta) ; else mclvInsertIdx(dag->cols+(t-mx->cols), v->vid, delta) ; } } } ; mclxWrite(dag, xfdiff, MCLXIO_VALUE_GETENV, EXIT_ON_FAIL) ; mclxFree(&dag) ; }
static void set_cl_to_projection ( mclMatrix* cl , mclMatrix* el_on_cl ) { dim i, j ; for (i=0;i<N_COLS(cl);i++) { mclv* clvec = cl->cols+i ; long clid = clvec->vid ; mclv* elclvec = NULL ; mclp* valivp = NULL ; for (j=0;j<clvec->n_ivps;j++) { long elid = clvec->ivps[j].idx ; elclvec = mclxGetVector(el_on_cl, elid, EXIT_ON_FAIL, elclvec) ; valivp = mclvGetIvp(elclvec, clid, NULL) ; if (!valivp && clvec->n_ivps > 1) mcxErr("clmCastActors", "match error: el %ld cl %ld", elid, clid) ; clvec->ivps[j].val = valivp ? MCX_MAX(0.01, valivp->val) : 0.01 ; } } }
mclVector* mclvCanonicalEmbed ( mclv* dst , const mclv* src , dim nr , double val ) { mclIvp* ivp ; dim d = 0 ; mclv* src_clone = NULL ; if (dst == src) src_clone = mclvClone(src) , src = src_clone ; dst = mclvResize(dst, nr) /* set everything to val */ ; ivp = dst->ivps ; while (ivp < dst->ivps+dst->n_ivps) { ivp->idx = d++ ; (ivp++)->val = val ; } /* insert src values */ /* fixme: use better implementation, * preferably with a callback */ ivp = dst->ivps ; for (d=0;d<src->n_ivps;d++) { ivp = mclvGetIvp(dst, src->ivps[d].idx, ivp) ; if (ivp) ivp->val = src->ivps[d].val ; } if (src_clone) mclvFree(&src_clone) ; return dst ; }
double mclvHasLoop ( const mclVector* vec ) { mclp* ivp = mclvGetIvp(vec, vec->vid, NULL) ; return ivp ? 1.0 : 0.0 ; }
static mcxstatus mateMain ( int argc_unused cpl__unused , const char* argv[] ) { mcxIO* xfx, *xfy ; mclx* mx, *my, *meet, *teem, *myt ; dim x, y ; mcxIOopen(xfout, EXIT_ON_FAIL) ; xfx = mcxIOnew(argv[0], "r") ; mx = mclxRead(xfx, EXIT_ON_FAIL) ; mcxIOclose(xfx) ; xfy = mcxIOnew(argv[1], "r") ; my = mclxRead(xfy, EXIT_ON_FAIL) ; myt = mclxTranspose(my) ; if (!MCLD_EQUAL(mx->dom_rows, my->dom_rows)) mcxDie(1, me, "domains are not equal") ; meet= mclxCompose(myt, mx, 0, 0) /* fixme thread interface */ ; teem= mclxTranspose(meet) ; if (legend) fprintf ( xfout->fp , "%-10s %6s %6s %6s %6s %6s %6s %6s\n" , "overlap" , "x-idx" , "y-idx" , "meet" , "xdiff" , "ydiff" , "x-size" , "y-size" ) ; for (x=0;x<N_COLS(meet);x++) { mclv* xvec = meet->cols+x ; long X = xvec->vid ; long xsize = mx->cols[x].n_ivps ; if (one2many && xvec->n_ivps < 2) continue ; for (y=0;y<N_COLS(teem);y++) { mclv* yvec = teem->cols+y ; long Y = yvec->vid ; long ysize = my->cols[y].n_ivps ; double twinfac ; long meetsize ; mclp* ivp = mclvGetIvp(yvec, X, NULL) ; if (!ivp) continue /* * meet size, left diff, right diff, right size. */ ; meetsize = ivp->val ; if (!xsize && !ysize) /* paranoia */ continue ; twinfac = 2 * meetsize / ( (double) (xsize + ysize) ) ; if (xfout) fprintf ( xfout->fp , "%-10.3f %6ld %6ld %6ld %6ld %6ld %6ld %6ld\n" , twinfac , X , Y , meetsize , xsize - meetsize , ysize - meetsize , xsize , ysize ) ; } } return STATUS_OK ; }
static dim do_add ( mclx* mx , dim N_add , dim N_edge , double *l_mean , double l_radius , double l_sdev , double l_min , double l_max , double skew , double e_min , double e_max ) { dim n_add = 0 ; while (n_add < N_add) { unsigned long r = (unsigned long) random() ; unsigned long s = (unsigned long) random() ; long x, y ; double val ; mclp* ivp ; dim xo = r % N_COLS(mx) /* fixme, modulo is commonly recommended against */ ; dim yo = s % N_COLS(mx) ; if (xo > yo) { long zo = xo ; xo = yo ; yo = zo ; } else if (xo == yo) /* never add loops */ continue ; x = mx->dom_cols->ivps[xo].idx ; y = mx->dom_cols->ivps[yo].idx ; if (N_edge >= N_COLS(mx) * (N_COLS(mx)-1) / 2) break ; ivp = mclvGetIvp(mx->cols+xo, y, NULL) ; if (ivp && ivp->val) continue ; if (l_mean) { do { val = mcxNormalCut(l_radius, l_sdev) ; if (skew) { val = (l_radius + val) / (2 * l_radius) /* ^ map (l_radius + val) to lie within [0,1] */ ; val = pow(val, skew) /* skew it */ ; val = (val * 2 * l_radius) - l_radius /* map it back */ ; } val += l_mean[0] ; } while (l_min < l_max && (val < l_min || val > l_max)) ; } /* docme: uniform */ else { val = (((unsigned long) random()) * 1.0) / RAND_MAX ; if (skew) val = pow(val, skew) ; val = e_min + val * (e_max - e_min) ; } if (!val) continue ;if(DEBUG)fprintf(stderr, "add [%d] %ld %ld value %f\n", (int) n_add, (long) x, (long) y, val) ; mclvInsertIdx(mx->cols+xo, y, val) ; N_edge++ ; n_add++ ; } return n_add ; }
void static do_the_shuffle ( mclx* mx , dim N_shuffle , dim* offsets /* size N_COLS(mx) */ , dim N_edge , dim random_ignore ) { dim n_shuffle = 0 ; while (n_shuffle < N_shuffle) { unsigned long rx = (unsigned long) random() ; unsigned long ry = (unsigned long) random() ; mclp* ivpll, *ivplr, *ivprl, *ivprr ; dim edge_x, edge_y, *edge_px, *edge_py ; ofs xro, yro, xlo, ylo = -1, vxo, vyo ; long xl, xr, yl, yr ; mclv* vecxl, *vecxr, *vecyl, *vecyr ; double xlval, xrval, ylval, yrval ; if (rx >= random_ignore || ry >= random_ignore) continue ; edge_x = rx % N_edge /* fixme probably not optimal */ ; edge_y = ry % N_edge /* fixme probably not optimal */ ; if (!(edge_px = mcxBsearchFloor(&edge_x, offsets, N_COLS(mx), sizeof edge_x, dimCmp))) mcxDie(1, me, "edge %ld not found (max %ld)", (long) edge_x, (long) N_edge) ; if (!(edge_py = mcxBsearchFloor(&edge_y, offsets, N_COLS(mx), sizeof edge_y, dimCmp))) mcxDie(1, me, "edge %ld not found (max %ld)", (long) edge_y, (long) N_edge) ; vxo = edge_px - offsets ; xl = mx->dom_cols->ivps[vxo].idx ; vecxl = mx->cols+vxo ; xro = edge_x - offsets[vxo] ; vyo = edge_py - offsets ; yl = mx->dom_cols->ivps[vyo].idx ; vecyl = mx->cols+vyo ; yro = edge_y - offsets[vyo] /* Offset computation gone haywire */ ; if (xro >= vecxl->n_ivps || yro >= vecyl->n_ivps) /* note: mixed sign comparison */ mcxDie(1, me, "paradox 1 in %ld or %ld", xl, yl) ; xr = vecxl->ivps[xro].idx ; yr = vecyl->ivps[yro].idx ; xrval = vecxl->ivps[xro].val ; yrval = vecyl->ivps[yro].val /* Impossible, should have graph */ ; vecxr = mclxGetVector(mx, xr, EXIT_ON_FAIL, NULL) ; vecyr = mclxGetVector(mx, yr, EXIT_ON_FAIL, NULL) /* check that we have four different nodes * loops are not present so no need to check those */ ; if (xl == yl || xl == yr || xr == yl || xr == yr) continue ; if ( (0 > (xlo = mclvGetIvpOffset(vecxr, xl, -1))) || (0 > (ylo = mclvGetIvpOffset(vecyr, yl, -1))) ) mcxDie ( 1 , me , "symmetry violation 1" " %ld not found in %ld/%ld OR %ld not found in %ld/%ld" , (long) xl, (long) vecxr->vid, (long) vecxr->n_ivps , (long) yl, (long) vecyr->vid, (long) vecyr->n_ivps ) /* Now: xl yl : ivpll * xl yr : ivplr * xr yl : ivprl * xr yr : ivprr */ ; xlval = vecxr->ivps[xlo].val ; ylval = vecyr->ivps[ylo].val ; ivpll = mclvGetIvp(vecxl, yl, NULL) ; ivplr = mclvGetIvp(vecxl, yr, NULL) ; ivprl = mclvGetIvp(vecxr, yl, NULL) ; ivprr = mclvGetIvp(vecxr, yr, NULL) ; if ( (ivpll && !mclvGetIvp(vecyl, xl, NULL)) || (ivplr && !mclvGetIvp(vecyr, xl, NULL)) || (ivprl && !mclvGetIvp(vecyl, xr, NULL)) || (ivprr && !mclvGetIvp(vecyr, xr, NULL)) ) mcxDie(1, me, "symmetry violation 2") ; if ((ivpll && ivplr) || (ivprl && ivprr)) continue ; { if (!ivpll && !ivprr) { /* vecxl <-> xr becomes vecxl <-> yl * vecxr <-> xl becomes vecxr <-> yr * vecyl <-> yr becomes vecyl <-> xl * vecyr <-> yl becomes vecyr <-> xr */ ; if ( mclvReplaceIdx(vecxl, xro, yl, xrval) || mclvReplaceIdx(vecyl, yro, xl, xrval) || mclvReplaceIdx(vecxr, xlo, yr, ylval) || mclvReplaceIdx(vecyr, ylo, xr, ylval) ) mcxDie(1, me, "parallel replacement failure\n") #if DEBUG ;fprintf(stderr, "parallel edge change remove %d-%d %d-%d add %d-%d %d-%d\n", vecxl->vid, xr, vecyr->vid, yl, vecxl->vid, yl, vecyr->vid, xr) #endif ; } else if (!ivplr && !ivprl) { /* vecxl -> xr becomes vecxl <-> yr * vecxr -> xl becomes vecxr <-> yl * vecyl -> yr becomes vecyl <-> xr * vecyr -> yl becomes vecyr <-> xl */ if ( mclvReplaceIdx(vecxl, xro, yr, xrval) || mclvReplaceIdx(vecyr, ylo, xl, xlval) || mclvReplaceIdx(vecxr, xlo, yl, yrval) || mclvReplaceIdx(vecyl, yro, xr, yrval) ) mcxDie(1, me, "cross replacement failure\n") #if DEBUG ;fprintf(stderr, "cross edge change remove %d-%d %d-%d add %d-%d %d-%d\n", vecxl->vid, xr, vecyl->vid, yr, vecxl->vid, yr, vecyl->vid, xr) #endif ; } } n_shuffle++ ; } }
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 ; }