Skip to content

Instantly share code, notes, and snippets.

@jonatack jonatack/dual.lisp forked from lispm/dual.lisp
Last active Jun 2, 2016

Embed
What would you like to do?
Conjugate Partitions
; http://kaygun.tumblr.com/post/145269023094/conjugate-partitions
; version 1
(defun dual (xs &aux k n r)
(loop while xs do
(setf k (reduce #'min xs)
n (length xs)
xs (sort (loop for x in xs
for x1 = (- x k)
unless (zerop x1)
collect x1)
#'<))
(loop repeat k do (push n r)))
r)
; version 2
(defun dual (xs &aux k k1 (n (length xs)) (n1 n) r)
(loop while xs do
(setf k (or k (reduce #'min xs))
k1 k
xs (sort (loop for x in xs
for x1 = (- x k)
when (zerop x1)
do (decf n1)
else collect x1 and do (when (< x1 k1) (setf k1 x1)))
#'<))
(loop repeat k do (push n r))
(setf n n1 k k1))
r)
; version 3
(defun dual (xs &aux (n (length xs)) (n1 n) r)
(setf xs (sort xs #'<))
(loop for k = (first xs)
while xs do
(setf xs (loop for x in xs
for x1 = (- x k)
when (zerop x1)
do (decf n1)
else collect x1))
(loop repeat k do (push n r))
(setf n n1))
r)
; version 4
(defun dual-aux-1 (xs k n r)
(if (null xs)
(values (reverse r) n)
(let ((i (- (first xs) k)))
(dual-aux-1 (rest xs)
k
(if (zerop i) (1- n) n)
(if (zerop i) r (cons i r))))))
(defun repeat (n i l)
(if (zerop n)
l
(repeat (1- n) i (cons i l))))
(defun dual-aux (xs n min r)
(if (null xs)
r
(multiple-value-bind (l len)
(dual-aux-1 xs min n nil)
(dual-aux l len (first l) (repeat (first xs) n r)))))
(defun dual (xs)
(when xs
(setf xs (sort xs #'<))
(dual-aux xs (length xs) (first xs) nil)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.