k mean clustering algorithm

[Satish_Rajdev]

Hello All,

Happy New Year!

I'm looking for lisp function for the k mean clustering, was wondering if anybody have that already who can share it.

k mean clustering algorithm:

https://en.wikipedia.org/wiki/K-means_clustering

[CodeDing]

@Satish_Rajdev ,

Doesn't seem terribly complicated. I'd be interested in trying to come up with a solution over this weekend. I will update with what I come up with. Are you working with 2D points or 3D points?

For those interested,

This Article about how to accomplish it in C# has some good pseudocode and graphics describing the process:

https://visualstudiomagazine.com/articles/2013/12/01/k-means-data-clustering-using-c.aspx

Best,

~DD

[doaiena]

Here is my quick attempt on the topic. It has one known bug. The code doesnt make sure that all clusters have at least 1 entity, so in some runs (with more clusters) it's possible to eat up all the entities of a cluster and error out. I post it as is (thats what makes it a quick attempt though). There are optimizations that can be implemented, depending on the size of the data set and the iterations you want to run.

I've prepared a function "AddSampleData", which adds points at random. I'm using "PDMODE" 33 to better see what's going on.

(defun c:test ( / numOfClusters maxIterations ss ctr ent pt cluster data means)

(if (setq ss (ssget '((0 . "POINT"))))
(progn

(setq numOfClusters 3)
(setq maxIterations 10)

(setq ctr 0)
(repeat (sslength ss)
(setq ent (ssname ss ctr)
      pt (cdr (assoc 10 (entget ent)))
      cluster (LM:randrange 1 numOfClusters)
)
(setq data (cons (list pt cluster ent) data))
(ColorPoint ent cluster)
(setq ctr (1+ ctr))
);repeat

(repeat maxIterations
(CalcMeans)
(setq data (CalcPoints))
);repeat
;;;(mapcar '(lambda (pt) (vl-cmdf "_circle" pt 10)) (mapcar 'car means));show means as circles
));if ss
(princ)
);defun

(defun CalcPoints ()

(mapcar '(lambda (x / pt cluster ent distances newCluster)
(setq pt (car x) cluster (cadr x) ent (caddr x))
(setq distances (mapcar '(lambda (mean) (list (distance pt (car mean)) (cadr mean))) means))
(setq newCluster (cadr (assoc (apply 'min (mapcar 'car distances)) distances)))

(if (/= cluster newCluster)
(progn
(ColorPoint ent newCluster)
(redraw ent);visualize changes
(list pt newCluster ent)
)
x
)
) data)
);defun


(defun CalcMeans ( / cluster)
(setq cluster 1 means nil)
(repeat numOfClusters
(setq means (cons (list (Average (mapcar 'car (vl-remove-if-not '(lambda (x) (equal (cadr x) cluster)) data))) cluster) means))
(setq cluster (1+ cluster))
)
);defun


(defun Average (data)
(mapcar '/ (apply 'mapcar (cons '+ data)) (list (length data) (length data) (length data)))
);defun


(defun ColorPoint (point color)
(setq ed (entget point) oldColor (assoc 62 ed))
(entmod (subst (cons 62 color) oldColor ed))
);defun


(defun AddSampleData ( / minX minY maxX maxY count pt)

(setq minX 0 minY 0 maxX 10000 maxY 10000 count 8000)
(repeat count
(setq pt (list (LM:randrange minX maxX) (LM:randrange minY maxY) 0))
(entmakex (list (cons 0 "POINT") (cons 10 pt) (cons 62 0)))
)
(princ)
);defun


;; Rand  -  Lee Mac
;; PRNG implementing a linear congruential generator with
;; parameters derived from the book 'Numerical Recipes'

(defun LM:rand ( / a c m )
    (setq m   4294967296.0
          a   1664525.0
          c   1013904223.0
          $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
    )
    (/ $xn m)
);defun


;; Random in Range  -  Lee Mac
;; Returns a pseudo-random integral number in a given range (inclusive)

(defun LM:randrange ( a b )
    (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
);defun

[Satish_Rajdev]

Thank you, Currently I'm working with only 2D points.

Thanks for sharing the C# link, I'll try that code.

[Satish_Rajdev]

Thank you for putting this effort. This is really awesome for the start, I can see there is a bug as you stated, I'll give more try on this code to make it better.