Run Code
|
API
|
Code Wall
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
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
12
LISP Quick Lab
45
Functions for Euler #152
#3ODD-GT-MILLION
lab12
L2.4
S17016281_ACTIVIDAD_20
hihi
invers of list