/prog/ - Fibonacci Butt Sort

Name: Anonymous 2009-08-16 23:08

Let us discuss the various implementations of theFIBONACCI BUTT SORT.

Name: Anonymous 2009-11-26 5:32



(defun compose (&rest fns)

  (if fns

      (let ((fn1 (car (last fns)))

        (fns (butlast fns)))

    #'(lambda (&rest args)

        (reduce #'funcall fns

            :from-end t

            :initial-value (apply fn1 args))))

    #'identity))



(defun cycle-fns (&rest functions)

       (let* ((n (length functions))

          (p 0)

          (array (loop 

                with a = (make-array (list n) 

                         :element-type 'function

                         :initial-element #'identity)

                for function in functions

                for i from 0 to (1- n) 

                do (setf (aref a i) function)

                finally (return a))))

         (lambda (&rest args)

           (prog1 

           (apply (aref array p) args)

         (setf p (mod (1+ p) n))))))



(defun bbcode (tag)

  (lambda (i)

    (format nil "[~A]~A[/~A]" tag i tag)))



(defun fibonacci-buttsort (string)

   (funcall (compose (bbcode "b") (bbcode "i"))

        (with-output-to-string (s)

          (mapc (lambda (x) (princ x s))

            (map 'list (cycle-fns (bbcode "o") (bbcode "u"))

             string)))))

EXPERT ARTIST

Fibonacci Butt Sort

1 Name: Anonymous 2009-08-16 23:08

195 Name: Anonymous 2009-11-26 5:32

Name: Anonymous 2009-08-16 23:08

Name: Anonymous 2009-11-26 5:32