/* 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
; }
