do-all-sums & groupby, Common Lisp

do-all-sums & groupby

;gnu clisp 2.49

(defmacro do-all-sums ((var elements &key (prune Nil prune?) var-depth (operator '+)) &body body)
(let ((lst (gensym)))
`(labels ((all-sums (,lst ,var ,@(if var-depth `(,var-depth)))
   ,@(if var-depth `((declare (type ,var-depth fixnum))))
   ,(if prune? `(if (,prune ,var) (return-from all-sums Nil)))
    (if (null ,lst) (progn ,@body)
    (progn
    (all-sums (cdr ,lst) ,var ,@(if var-depth `((1+ ,var-depth))))
    (all-sums (cdr ,lst) (,operator ,var (car ,lst)) ,@(if var-depth `(,var-depth)))))))
    (all-sums ,elements 0 ,@(if var-depth `(0))))))

(pprint (macroexpand '(do-all-sums (v '(1/16 1/64 1/256 1/1024 1/4096) :var-depth d :prune (lambda (x) (> x 0.1))) (push (- 1/4 v) frac))))

(let ((frac))
(do-all-sums (v '(1/16 1/64 1/256 1/1024 1/4096) :var-depth d) (push d frac))
(pprint (sort frac #'<)))

(defun group-by (lst func)
      (loop with alist = Nil
               for i in lst for k = (funcall func i) for j = (assoc k alist)
               if j do (push i (cdr j)) else do (push (list k i) alist)
               finally (return alist)))

(setf alist
(loop with sieve = (make-array '(79) :initial-element Nil) with alist = Nil
         for i from 2
         for j across sieve
         do (if j (push (expt i -2) (cdr (assoc j alist)))
                    (progn (push (list i) alist) (loop for k from i to 80 by i do (setf (aref sieve ( - k 2)) i))))
         finally (return alist)))

;; Test functions

(let ((frac))
(do-all-sums (v '(1/16 1/64 1/256 1/1024 1/4096)) (push (- 1/4 v) frac))
(pprint (sort frac #'<)))

(defun list-sums (lst)
    (loop for i in lst summing i into s collecting s into val finally (return (reverse val))))

(loop for i on alist while (cddr i)
         if (> (length (cdar i)) 2)
              do (do-all-sums (j (cddar i))
                        (if (and (not (zerop j))
                                    (not (zerop (rem (denominator j) (caar i)))))
                             (push j (cdr (assoc-if #'(lambda (x) (zerop (rem (denominator j) x))) i)))))
         finally (pprint (cdar i)))

(do-all-sums (v (loop for i from 13 to 80 by 13 collecting (expt i -2)))
     (if (> (rem (denominator v) 13) 0) (pprint v)))

(pprint (group-by '(1 2 3 4 5 6) #'(lambda (x) (rem x 4))))


run \| edit \| history \| help	0