git.fiddlerwoaroof.com
bisorter.lisp
3bf1c97c
 (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*))