(defmacro sq (x) `(* ,x ,x)) (defmacro last-item (lst) `(car (last ,lst))) (defun good-reverse (lst) (labels ((rev (lst acc) (if (null lst) acc (rev (cdr lst) (cons (car lst) acc))))) (rev lst nil))) (defun prime-sieve-a-list (input-lst) (labels ((sieve-iter (go-lst acc-list) (if (not go-lst) acc-list (if (> (sq (car go-lst)) (last-item go-lst)) (append (good-reverse acc-list) go-lst) (sieve-iter (remove-if #'(lambda (x) (= (mod x (car go-lst)) 0)) (cdr go-lst)) (cons (car go-lst) acc-list)))))) (sieve-iter input-lst '()))) (defun range (max &key (min 0) (step 1)) (loop :for n :from min :below max :by step collect n)) (defmacro prime-sieve (n) `(prime-sieve-a-list (cons 2 (range (1+ ,n) :min 3 :step 2)))) (time (length (prime-sieve 20000000))) ;; Evaluation took: ;; 19.907 seconds of real time
What is the value of the first triangle number to have over five hundred divisors?
(defun factor-iter (n p-list acc-list) (if (NULL p-list) acc-list (let* ((p (car p-list)) (ps (cdr p-list))) (cond ((> (* p p) n) (good-reverse (cons n acc-list))) ((eql (mod n p) 0) (factor-iter (floor n p) p-list (cons p acc-list))) ('t (factor-iter n ps acc-list)))))) (defparameter *pm* 2000000) (defparameter *psi* (prime-sieve *pm*)) (defun factor (n) (if (> n (expt *pm* 2)) (let ((m (floor (sqrt n)))) (factor-iter n (prime-sieve m) '())) (factor-iter n *psi* '()))) (defun group-factors (lst) (labels ((gf (acc lst) (if (NULL lst) (good-reverse acc) (let* ((p (car lst)) (ps (cdr lst)) (lp1 (list p 1))) (if (NULL acc) (gf (list lp1) ps) (if (eql p (caar acc)) (gf (cons (list p (+ 1 (cadar acc))) (cdr acc)) ps) (gf (cons lp1 acc) ps))))))) (gf '() lst))) (defmacro sum (lst) `(reduce #'+ ,lst)) (defmacro product (lst) `(reduce #'* ,lst)) (defun nDiv (n) (product (mapcar #'(lambda (x) (1+ (cadr x))) (group-factors (factor n))))) (defun fm (m n) (labels ((tri-div (n) (if (evenp n) (* (nDiv (/ n 2)) (nDiv (1+ n))) (* (nDiv n) (nDiv (/ (1+ n) 2)))))) (if (> (tri-div n) m) (/ (* n (1+ n)) 2) (fm m (+ 1 n))))) ; (time (fm 500 1)) ;; Evaluation took: ;; 0.007 seconds of real time ;; 76576500
— Me@2023-03-25 07:51:18 PM
.
.
2023.03.27 Monday (c) All rights reserved by ACHK
You must be logged in to post a comment.