git.fiddlerwoaroof.com
Raw Blame History
(defpackage :3dr.bisorter
  (:use :alexandria :serapeum :cl))

(in-package :3dr.bisorter)

(defun make-adj-arr (&optional (size 25))
  (make-array size :adjustable t :fill-pointer 0))

(defclass bilayer ()
  ((fg :initarg :fg :accessor fg :initform (make-adj-arr))
   (bg :initarg :bg :accessor bg :initform (make-adj-arr))
   (dimension :initarg :dimension :accessor dimension)
   (center :initarg :center :accessor center)))

(defun split-points (points bilayer)
  (with-slots (fg bg dimension center) bilayer
    (map nil
         (lambda (point)
           (if (< (elt center dimension) (elt point dimension))
             (vector-push-extend point fg)
             (vector-push-extend point bg)))
         points)
    bilayer))

(defmethod print-object ((object bilayer) s)
  (print-unreadable-object (object s :type t :identity t)
    (with-slots (fg bg dimension center) object
      (format s "center: ~s div on: ~s (~d fg, ~d bg)"
              center dimension
              (length fg)
              (length bg)))))

(defun split-bilayer (bilayer)
  (with-slots (fg bg dimension center) bilayer
    (let* ((new-dimension (mod (1+ dimension)
                               (length center)))
           (new-fg-bilayer (make-instance 'bilayer
                                       :dimension new-dimension
                                       :center center))
           (new-bg-bilayer (make-instance 'bilayer
                                       :dimension new-dimension
                                       :center center)))
      (list (split-points fg new-fg-bilayer)
            (split-points bg new-bg-bilayer)))))

(defvar *bis*)
(defvar *points*)

(defun main ()
  (setf *bis* (make-instance 'bilayer
                             :dimension 0
                             :center (vector 0 0 0)))

  (flet ((100- (x) (- 100 x)))
    (setf *points*
          (loop repeat 1000
                collect (vector (random 200)
                                (100- (random 200))
                                (100- (random 200))))))

  (split-points *points* *bis*))