Jack Cole's Murray Polygon

Jack Cole's Murray Polygon is a concept for polygons which can fill arbitrary space via multi-radix ("Murray") traversal.

S Algol code for Murray Polygon

The original 1987 algorithm

!Test fast murray polygon algorithm. 4/11/87
let scale.fac = Y.dim( screen ) / X.dim( screen )

procedure change.parities( *bool p;int start )

for i = start to 1 by -2 do p( i ) := ~p( i )

procedure increment( *int d,r;int i -> int )

if d( i ) < r( i ) - 1 then { d( i ) := d( i ) + 1;i }

else { d( i ) := 0;increment( d,r,i + 1 ) }

procedure get.rads( *int digits,radices;int x.rad,y.rad )
begin

write "x radices > "
for i = 1 to 2 * x.rad by 2 do radices( i ) := readi()
write "y radices > "
for i = 2 to 2 * y.rad by 2 do radices( i ) := readi()

end

procedure number.pts( *int r;int start,inc -> int )
begin

let res := 1
for j = start to upb( r ) - 1 by inc do
res := res * r( j )
res

end

!Main

write "Number of x radices > "
let x.rad = readi()
write "Number of y radices > "
let y.rad = readi()
let max.rad = if x.rad > y.rad then x.rad else y.rad
let complexity = 2 * max.rad
let digits = vector 1 :: complexity + 1 of 0
let radices = vector 1 :: complexity + 1 of 1
let parities = vector 1 :: complexity + 1 of true
get.rads( digits,radices,x.rad,y.rad )
let no.pts := number.pts( radices,1,1 )
let nx := number.pts( radices,1,2 )
let ny := number.pts( radices,2,2 )
let width = if nx > ny then nx else ny
let x1 := 0
let y1 := 0
let x2 := 0
let y2 := 0
let next.seg := nilpic
for i = 1 to no.pts do
begin

let i = increment( digits,radices,1 )
change.parities( parities,i )
let inc = if parities( i + 1 ) then 1 else -1
if i rem 2 = 1 then x2 := x2 + inc else y2 := y2 + inc
next.seg := next.seg & [x1,y1] ^ [x2,y2]
if i rem 2 = 1 then x1 := x2 else y1 := y2

end
draw( screen,next.seg, -0.15 * width,0.85 * width,0,width )

LISP

(defun make-vec (upb initial)
  (make-array (1+ upb) :initial-element initial))

(defun upb (v)
  (1- (length v)))

(defun change-parities (parities start)
  (loop for i from start downto 1 by 2
        do (setf (aref parities i) (not (aref parities i))))
  parities)

(defun increment (digits radices i)
  (cond ((> i (upb digits)) nil)
        ((< (aref digits i) (1- (aref radices i)))
         (incf (aref digits i))
         i)
        (t (setf (aref digits i) 0)
           (increment digits radices (1+ i)))))

(defun number-pts (radices start inc)
  (let ((res 1))
    (loop for j from start to (1- (upb radices)) by inc
          do (setf res (* res (aref radices j))))
    res))

(defun get-rads (radices x-rad y-rad)
  (format t "x radices > ")
  (force-output)
  (loop for i from 1 to (* 2 x-rad) by 2
        do (setf (aref radices i) (read)))
  (format t "y radices > ")
  (force-output)
  (loop for i from 2 to (* 2 y-rad) by 2
        do (setf (aref radices i) (read)))
  radices)

(defun murray-segments (x-radices y-radices)
  (let* ((x-rad (length x-radices))
         (y-rad (length y-radices))
         (max-rad (max x-rad y-rad))
         (complexity (* 2 max-rad))
         (digits (make-vec (1+ complexity) 0))
         (radices (make-vec (1+ complexity) 1))
         (parities (make-vec (1+ complexity) t)))
    (loop for r in x-radices for i from 1 by 2 do (setf (aref radices i) r))
    (loop for r in y-radices for i from 2 by 2 do (setf (aref radices i) r))
    (let ((no-pts (number-pts radices 1 1))
          (nx (number-pts radices 1 2))
          (ny (number-pts radices 2 2))
          (x1 0) (y1 0) (x2 0) (y2 0)
          (segments '()))
      (dotimes (n no-pts)
        (let ((i (increment digits radices 1)))
          (unless i (return))
          (change-parities parities i)
          (let ((inc (if (aref parities (1+ i)) 1 -1)))
            (if (oddp i)
                (incf x2 inc)
                (incf y2 inc))
            (push (list x1 y1 x2 y2) segments)
            (if (oddp i)
                (setf x1 x2)
                (setf y1 y2)))))
      (values (nreverse segments) (max nx ny)))))

(defun murray-points (x-radices y-radices)
  (multiple-value-bind (segments width) (murray-segments x-radices y-radices)
    (values (cons (list 0 0)
                  (mapcar (lambda (s) (list (third s) (fourth s))) segments))
            width)))

(defun main ()
  (format t "Number of x radices > ")
  (force-output)
  (let* ((x-rad (read))
         (y-rad (progn (format t "Number of y radices > ")
                       (force-output)
                       (read)))
         (complexity (* 2 (max x-rad y-rad)))
         (radices (make-vec (1+ complexity) 1)))
    (get-rads radices x-rad y-rad)
    (murray-points
     (loop for i from 1 to (* 2 x-rad) by 2 collect (aref radices i))
     (loop for i from 2 to (* 2 y-rad) by 2 collect (aref radices i)))))

External Resources

• https://info.cs.st-andrews.ac.uk/student-handbook/school/jack-cole/murray-polygon.html