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