let sqr = \x -> (mulf (x, x)) in let addPoints = \((x1,y1),(x2,y2)) -> (addf (x1,x2), addf (y1,y2)) in let divPoint = \((x,y),q) -> (divf (x,q), divf (y,q)) in let distPoints = \((x1,y1),(x2,y2)) -> (sqrt (addf (sqr (subf (x2,x1)), sqr (subf (y2,y1))))) in -- init points -- Map pointId (newClusId, -- oldClusId, pos, dist) let points0 = map (id, \_ -> (0,0,(randf(),randf()),0.0), range (1,10000,1)) in -- init clusters :: Map clusId pos let clusters0 = map (id, \_ -> (randf(), randf()), range (1,10,1)) in -- iterate until convergence while (\(points, clusters, _) -> ( -- calculate distances between -- points and cluster centres -- Map (pointId, newClusId) -- ((oldClusId, pointPos),clusPos) let dists = map (id, \((pid,ncid),((ncid,ocid,ppos,d),cpos)) -> (ocid, ppos, distPoints (cpos, ppos)), cross (points, clusters)) in -- cnew memberships to min the dists -- Map pointId (newClusId,oldClusId, -- pointPos,distFromClus) let points' = groupReduce ( \((pid,_),_) -> pid, \((_,ncid),(ocid, ppos, d)) -> (ncid, ocid, ppos, d), \((nc1,oc1,p1,d1),(nc2,oc2,p2,d2)) -> (if ltf (d1,d2) then (nc1,oc1,p1,d1) else (nc2,oc2,p2,d2)), dists) in -- new cluster centres (avg mem pos) -- Map clusterId (summedPos, memCount) let clusters' = groupReduce ( \(pid,(ncid,ocid,ppos,d)) -> ncid, \(pid,(ncid,ocid,ppos,d)) -> (ppos, 1), \((sum1,tot1),(sum2,tot2)) -> (addPoints (sum1, sum2), addi (tot1, tot2)), points') in let clusters'' = map (id, \(ncid, (psum, ptot)) -> divPoint (psum, toFloat ptot), clusters') in -- total number mem changes let totalChanged = reduce (\(pid,(ncid,ocid,ppos,d)) -> (if eq (ncid, ocid) then 0 else 1), addi, points') in (points', clusters'', totalChanged)), -- loop until <= 10 mem changes \(_, _, totalChanged) -> (gti (totalChanged, 10)), (points0, clusters0, 10000))