diff --git a/p23/p23.org b/p23/p23.org index 2caff2c..cb1b3c8 100644 --- a/p23/p23.org +++ b/p23/p23.org @@ -151,17 +151,16 @@ co,de,ka,ta. #+begin_src emacs-lisp (defun grow-clusters(dataset) (let ((counter 0)) - (-distinct - (--map (-sort #'string< it) - (-mapcat (lambda (cluster) - (message (format "cluster %d . %d / %d" (length - cluster) - counter (length dataset))) - (setq counter (+ 1 counter)) - (--map (cons it cluster) - (-reduce #'-intersection - (-map #'neighbours cluster)))) - dataset))))) + (prune-clusters + (-mapcat (lambda (cluster) + (message (format "cluster %d . %d / %d" (length + cluster) + counter (length dataset))) + (setq counter (+ 1 counter)) + (--map (cons it cluster) + (-reduce #'-intersection + (-map #'neighbours cluster)))) + dataset)))) (-filter #'good-computer-p computer-list) @@ -169,7 +168,7 @@ co,de,ka,ta. (when l (cons l l))) - (setq links (--map (list (car it) (cdr it)) data-asym)) + (setq links (prune-clusters (--map (list (car it) (cdr it)) data-asym))) #+end_src #+RESULTS: @@ -260,7 +259,6 @@ co,de,ka,ta. | xx | xa | | re | wy | | ux | zt | -| pr | wz | | kx | qq | | ja | dw | | pi | zk | @@ -296,7 +294,6 @@ co,de,ka,ta. | fo | fb | | iv | no | | nw | rk | -| yg | wz | | wp | se | | dx | qw | | vl | dg | @@ -314,7 +311,6 @@ co,de,ka,ta. | bg | iy | | hc | dc | | re | rj | -| qp | pr | | bq | gk | | tt | la | | dj | aj | @@ -379,7 +375,6 @@ co,de,ka,ta. | cx | ym | | eh | ax | | fp | iv | -| wz | ml | | fm | ju | | tf | xa | | ge | yi | @@ -499,7 +494,6 @@ co,de,ka,ta. | lr | fd | | gl | cj | | ed | ls | -| qp | tg | | ov | ob | | sv | zs | | ut | qm | @@ -662,7 +656,6 @@ co,de,ka,ta. | dg | cl | | xn | pf | | cs | az | -| wz | zo | | er | kl | | ws | us | | ik | il | @@ -702,7 +695,6 @@ co,de,ka,ta. | ez | de | | zd | vu | | ln | mp | -| wz | xq | | uh | fm | | wh | qm | | hf | df | @@ -828,7 +820,6 @@ co,de,ka,ta. | yi | ko | | ja | nn | | cp | mz | -| ml | qp | | dl | yk | | nb | rj | | ra | wn | @@ -1354,7 +1345,6 @@ co,de,ka,ta. | zc | ef | | mi | su | | py | iy | -| ho | qp | | wl | mo | | vs | iz | | iu | il | @@ -1397,7 +1387,6 @@ co,de,ka,ta. | fh | fo | | di | xp | | bq | te | -| wz | tg | | fq | sv | | ba | er | | fv | ow | @@ -1615,7 +1604,6 @@ co,de,ka,ta. | ea | gt | | wr | so | | gm | cf | -| qp | hx | | ae | ov | | tm | tn | | zv | xy | @@ -2071,7 +2059,6 @@ co,de,ka,ta. | ea | go | | ep | wk | | tl | ob | -| wz | hx | | lg | lz | | hx | xo | | zg | dw | @@ -2432,7 +2419,6 @@ co,de,ka,ta. | yo | gb | | lj | pn | | pv | ay | -| qp | zo | | wf | pb | | nj | kb | | qo | ik | @@ -2649,7 +2635,6 @@ co,de,ka,ta. | ho | un | | eh | ch | | jv | sw | -| fu | wz | | dp | us | | ij | ct | | lz | vo | @@ -2690,7 +2675,6 @@ co,de,ka,ta. | kr | mi | | la | vl | | js | tr | -| ee | qp | | ae | cp | | wr | qm | | lj | ez | @@ -2704,7 +2688,6 @@ co,de,ka,ta. | hb | re | | iu | we | | ty | fs | -| jj | qp | | ih | yr | | bs | yz | | pj | gp | @@ -2718,7 +2701,6 @@ co,de,ka,ta. | aa | tw | | ub | iy | | fx | hj | -| qp | fu | | qq | gt | | ys | jo | | xm | fh | @@ -2798,7 +2780,6 @@ co,de,ka,ta. | fk | cx | | sc | gh | | xp | hu | -| ee | wz | | xr | gx | | va | zm | | gs | ev | @@ -2828,7 +2809,6 @@ co,de,ka,ta. | cs | ft | | ys | gf | | gg | im | -| xo | wz | | ln | ah | | ot | dm | | zh | hm | @@ -2891,7 +2871,6 @@ co,de,ka,ta. | no | ip | | st | ec | | xv | ty | -| qp | qr | | vz | wr | | yz | as | | xg | hj | @@ -2934,7 +2913,6 @@ co,de,ka,ta. | hb | tx | | ba | bi | | wa | sl | -| qr | wz | | my | bq | | yw | oj | | wk | hc | @@ -2998,7 +2976,6 @@ co,de,ka,ta. | bt | dj | | wc | og | | au | ao | -| xo | qp | | bf | jc | | jb | dl | | wx | jp | @@ -3305,7 +3282,6 @@ co,de,ka,ta. | bq | df | | rj | mh | | go | vp | -| yg | qp | | js | kd | | pb | fc | | lz | xs | @@ -3429,7 +3405,6 @@ co,de,ka,ta. | jp | vn | | jc | ly | | xi | ch | -| wz | jj | | zr | ag | | ya | fz | | zt | mt | @@ -3554,7 +3529,18 @@ co,de,ka,ta. | ys | vt | | wt | kz | + #+begin_src emacs-lisp + (defun prune-clusters (clusters) + (let ((remove-list (car clusters)) + (remainder (cdr clusters)) + ) + (when remove-list (cons remove-list (--remove (-intersection it remove-list) remainder))) + ) + ) + + + (setq poly-sequence (--unfold (split (grow-clusters it)) links)) ; (-last-item poly-sequence)