Euler problem 12.1.1

(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