Browse code
feat: crdt protocol, simple counters
Ed L authored on 16/10/2020 06:50:14Showing 1 changed files
| 1 | 1 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,92 @@ |
| 1 |
+(defpackage :fwoar.crdt |
|
| 2 |
+ (:use :cl) |
|
| 3 |
+ (:export )) |
|
| 4 |
+(in-package :fwoar.crdt) |
|
| 5 |
+ |
|
| 6 |
+(defgeneric crdt-update (op crdt)) |
|
| 7 |
+(defgeneric crdt-query (crdt)) |
|
| 8 |
+(defgeneric crdt-compare (less greater)) |
|
| 9 |
+(defgeneric crdt-merge (id first second)) |
|
| 10 |
+ |
|
| 11 |
+(fw.lu:defclass+ g-counter () |
|
| 12 |
+ ((id :reader my-id :initarg :id) |
|
| 13 |
+ (size :reader size :initarg :size) |
|
| 14 |
+ (payload :reader payload))) |
|
| 15 |
+(defmethod print-object ((o g-counter) s) |
|
| 16 |
+ (with-slots (id size) o |
|
| 17 |
+ (prin1 `(g-counter :id ,id :size ,size) |
|
| 18 |
+ s))) |
|
| 19 |
+(defmethod initialize-instance :after ((crdt g-counter) &key size) |
|
| 20 |
+ (with-slots (payload) crdt |
|
| 21 |
+ (setf payload (make-array size)))) |
|
| 22 |
+(defmethod crdt-update ((op (eql :increment)) (crdt g-counter)) |
|
| 23 |
+ (incf (aref (payload crdt) |
|
| 24 |
+ (my-id crdt)))) |
|
| 25 |
+(defmethod crdt-query ((crdt g-counter)) |
|
| 26 |
+ (reduce #'+ |
|
| 27 |
+ (payload crdt))) |
|
| 28 |
+(defmethod crdt-compare ((x g-counter) |
|
| 29 |
+ (y g-counter)) |
|
| 30 |
+ (every #'<= |
|
| 31 |
+ (payload x) |
|
| 32 |
+ (payload y))) |
|
| 33 |
+(defmethod crdt-merge (id |
|
| 34 |
+ (x g-counter) |
|
| 35 |
+ (y g-counter)) |
|
| 36 |
+ (assert (= (size x) |
|
| 37 |
+ (size y)) |
|
| 38 |
+ (x y)) |
|
| 39 |
+ (let ((z (g-counter id (size x)))) |
|
| 40 |
+ (prog1 z |
|
| 41 |
+ (loop for i from 0 below (size x) |
|
| 42 |
+ do |
|
| 43 |
+ (setf (aref (payload z) i) |
|
| 44 |
+ (max (aref (payload x) i) |
|
| 45 |
+ (aref (payload y) i))))))) |
|
| 46 |
+ |
|
| 47 |
+(fw.lu:defclass+ pn-counter () |
|
| 48 |
+ ((id :reader my-id :initarg :id) |
|
| 49 |
+ (size :reader size :initarg :size) |
|
| 50 |
+ (positives :reader positives) |
|
| 51 |
+ (negatives :reader negatives))) |
|
| 52 |
+(defmethod initialize-instance :after ((crdt pn-counter) &key id size) |
|
| 53 |
+ (with-slots (positives negatives) crdt |
|
| 54 |
+ (setf positives (g-counter id size) |
|
| 55 |
+ negatives (g-counter id size)))) |
|
| 56 |
+(defmethod print-object ((o pn-counter) s) |
|
| 57 |
+ (with-slots (id size positives negatives) o |
|
| 58 |
+ (prin1 `(pn-counter :id ,id :size ,size) |
|
| 59 |
+ s))) |
|
| 60 |
+(defmethod payload ((object pn-counter)) |
|
| 61 |
+ (with-slots (positives negatives) object |
|
| 62 |
+ (list :positives (payload positives) |
|
| 63 |
+ :negatives (payload negatives)))) |
|
| 64 |
+(defmethod crdt-update ((op (eql :increment)) (crdt pn-counter)) |
|
| 65 |
+ (crdt-update :increment (positives crdt))) |
|
| 66 |
+(defmethod crdt-update ((op (eql :decrement)) (crdt pn-counter)) |
|
| 67 |
+ (crdt-update :increment (negatives crdt))) |
|
| 68 |
+(defmethod crdt-query ((crdt pn-counter)) |
|
| 69 |
+ (- (crdt-query (positives crdt)) |
|
| 70 |
+ (crdt-query (negatives crdt)))) |
|
| 71 |
+(defmethod crdt-compare ((x pn-counter) |
|
| 72 |
+ (y pn-counter)) |
|
| 73 |
+ (and (crdt-compare (positives x) (positives y)) |
|
| 74 |
+ (crdt-compare (negatives x) (negatives y)))) |
|
| 75 |
+(defmethod crdt-merge (id |
|
| 76 |
+ (x pn-counter) |
|
| 77 |
+ (y pn-counter)) |
|
| 78 |
+ (assert (= (size x) |
|
| 79 |
+ (size y)) |
|
| 80 |
+ (x y)) |
|
| 81 |
+ (let ((z (pn-counter id (size x)))) |
|
| 82 |
+ (prog1 z |
|
| 83 |
+ (with-slots (positives negatives) z |
|
| 84 |
+ (with-slots ((p-x positives) (n-x negatives)) x |
|
| 85 |
+ (with-slots ((p-y positives) (n-y negatives)) y |
|
| 86 |
+ (setf positives (crdt-merge id p-x p-y) |
|
| 87 |
+ negatives (crdt-merge id n-x n-y)))))))) |
|
| 88 |
+ |
|
| 89 |
+(defun make-cluster (size class) |
|
| 90 |
+ (values-list |
|
| 91 |
+ (loop for id from 0 below size |
|
| 92 |
+ collect (make-instance class :id id :size size)))) |