Euler problem 21.1

Posted on August 6, 2024 by rpflee

(defmacro sum (lst)
  `(reduce #'+ ,lst))

(defun proper-divisors (n)
  (when (> n 1)  
    (let ((divisors '())
          (limit (floor (sqrt n))))  
      (loop :for i :from 1 :to limit
            :when (zerop (mod n i))  
              :do (progn
                    (push i divisors)  
                    (when (/= n (floor n i))  
                      (push (floor n i)
                            divisors))))  
      (remove-duplicates (sort divisors #'<)
                         :test
                         #'equal))))

(defmacro sum-proper-divisors (n)
  `(sum (proper-divisors ,n)))

(defun amicable-numbers (limit)
  (let ((amicable-pairs '()))
    (loop :for a :from 2 :below limit
          :do (let* ((b (sum-proper-divisors a))
                     (c (sum-proper-divisors b)))
                (when (and (or (< b a)
                               (>= b limit))
                           (= a c))                      
                  (push a amicable-pairs)                 
                  (when (< b limit)
                    (push b amicable-pairs)))))
    (remove-duplicates amicable-pairs
                       :test
                       #'equal)))

(sum (amicable-numbers 10000))

 
CL-USER> (sum (amicable-numbers 10000))
31626
CL-USER>

— Me@2024-08-06 03:47:01 PM

Batman: Return of the Joker

Posted on June 26, 2024 by rpflee

Euler problem 20.1

Find the sum of the digits in the number $\displaystyle{100!}$ .

(reduce #'+
        (map 'list #'digit-char-p
             (write-to-string
              (reduce #'* (loop for i
                                from 1 to 100
                                collect i)))))

CL-USER> 
648

— Me@2024-06-25 08:26:22 PM

Euler problem 19.1

Posted on January 30, 2024 by rpflee

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

(defun is-leap-year (year)
  (or (and (zerop (mod year 4))
           (not (zerop (mod year 100))))
      (zerop (mod year 400))))

(defun days-in-month (month year)
  (case month
    ((1 3 5 7 8 10 12) 31)
    ((4 6 9 11) 30)
    (2 (if (is-leap-year year)
           29
           28))))

(defun euler-19 ()
  (let ((day-of-week 2) ; 1 Jan 1901 was a Tuesday
        (sundays 0))
    (loop :for year :from 1901 :to 2000 :do
      (loop :for month :from 1 :to 12 :do
        (when (zerop day-of-week) ; 0 represents Sunday
          (incf sundays))
        (setf day-of-week
              (mod
               (+ day-of-week
                  (days-in-month month year))
               7))))
    sundays))

(print (euler-19))

CL-USER> (euler-19)
171
CL-USER>

— Me@2024-01-30 01:46:11 PM

Euler problem 18.1

Posted on December 21, 2023 by rpflee

(ql:quickload "str")

;; (defun file-get-contents (filename)
;;   (with-open-file (stream filename)
;;     (let ((contents (make-string
;;                      (file-length stream))))
;;       (read-sequence contents stream)
;;       contents)))

(defun file-get-lines (filename)
  (with-open-file (stream filename)
    (loop :for line = (read-line stream nil)
          :while line
          :collect line)))

;; (defun string-to-list (the-string)
;;   (loop :for char :across the-string
;;         :collect char))

;; (defun char-to-integer-list (char-list)
;;   (mapcar #'digit-char-p char-list))

(defun path-add-item (x yys zzs)
  (let* ((y (car yys))
         (ys (cdr yys))
         (z (car zzs))
         (zs (cdr zzs))
         (m (if (> y z) y z))
         (ms (if (> y z) ys zs)))
    (cons (+ x m) (cons x ms))))

(defmacro zipWith3 (f xs ys zs)
  `(mapcar ,f ,xs ,ys ,zs))

(defun path-add-item-zip (acc xs)
  (zipWith3 #'path-add-item xs acc (cdr acc)))

(defun foldl (f acc xs)
  (if (not xs)
      acc
      (foldl f (funcall f acc (car xs)) (cdr xs))))

(defun string-split (x)
  (str:split #\space x))

(defun map-parse-integer (xs)
  (mapcar #'parse-integer xs))

(defmacro map-string-split (xs)
  `(mapcar #'string-split ,xs))

(defmacro head (xs)
  `(car ,xs))

(defmacro tail (xs)
  `(cdr ,xs))

(defun pair-double (x)
  (list x x))

(defun e18 ()
  (let* ((string-lines (file-get-lines #P"n.txt"))
         (string-lists (map-string-split string-lines))
         (number-tower (mapcar #'map-parse-integer
                               string-lists))
         (r-tower (reverse number-tower))
         (acc (mapcar #'pair-double (head r-tower))))
    
    (foldl #'path-add-item-zip acc (tail r-tower))))

CL-USER> (e18)
((1074 75 64 82 87 82 75 73 28 83 32 91 78 58 73 93))
CL-USER>

— Me@2023-12-20 07:32:00 PM

Eval the buffer

Posted on December 11, 2023 by rpflee

(defun common-lisp-eval (str)
  (unless (slime-current-connection)
    (let ((wnd (current-window-configuration)))
      (slime)
      (while (not (and (slime-current-connection)
                       (get-buffer-window
                        (slime-output-buffer))))
        (sit-for 0.2))
      (set-window-configuration wnd)))
  (let (deactivate-mark)
    (slime-eval `(swank:eval-and-grab-output ,str))))

(defun file-eval ()
  (interactive)
  (message
   (car (common-lisp-eval
         (concat "(format t \"~{~a~%~}\" (list "
                 (string-make-unibyte
                  (buffer-string)) "))")))))

(defun region-eval (from to)
  (interactive "r")
  (message
   (car (common-lisp-eval
         (concat "(format t \"~{~a~%~}\" (list "
                 (string-make-unibyte
                  (buffer-substring
                   from to)) "))")))))

(global-set-key (kbd "C-F") 'file-eval)
(global-set-key (kbd "C-R") 'region-eval)

— Me@2023-12-10 09:59:57 AM

Quicklisp error

Posted on November 23, 2023 by rpflee

Common Lisp calculator, 2

1. To run the following code, you have to install the Quicklisp library manager by following the steps in my blog post titled cmu-infix.

2.1 To enable the library, in the Common Lisp REPL, run the code:

(ql:quickload :cmu-infix)

(named-readtables:in-readtable cmu-infix:syntax)

2.2 If you encounter the error message:

Lisp connection closed unexpectedly: connection broken by remote peer

2.2.1 empty the cache folder:

~/.cache/common-lisp/

2.2.2 Restart the Common Lisp REPL.

2.2.3 Reload the library.

3.1 The goal of the following code is to create our own REPL.

(defmacro infix-string-eval (a-string)
  `(eval (read-from-string
          (concatenate 'string
                       "#I (" ,a-string ")"))))

(defun read-repl-all ()
  (loop (print (write-to-string (read)))))

(defun my-repl ()
  (loop
    (let ((a-string (write-to-string (read))))
      (if (or (string-equal "(exit)" a-string)
              (string-equal "exit" a-string))
          (return)            
          (print
           (infix-string-eval
            (string-trim "|()" a-string)))))))

3.2 In the Common Lisp REPL, run the code:

(my-repl)

— Me@2022-12-26 01:10:34 PM

The symbol

is the bitwise exclusive OR.

To create an exponentiation, we use

^^

— Me@2023-09-09 12:51:46 PM

— Me@2023-11-22 12:56:00 PM

Euler problem 17.1

Posted on October 26, 2023 by rpflee

(defun remove-char (lst string)
  (cond ((not lst) string)
        ('t (remove-char (cdr lst)
                         (remove (car lst)
                                 string)))))

(defmacro english-reduced (n)
  `(length (remove-char (list #\- #\space)
                        (format nil "~r" ,n))))

(defmacro english-and (n)
  `(cond
     ((= (mod n 100) 0) (english-reduced ,n))
     ((> ,n 100) (+ 3 (english-reduced ,n)))
     ('t (english-reduced ,n))))

(defun e17 ()
  (labels ((e17-iter (n acc)
             (cond ((<= n 0) acc)
                   ('t (e17-iter (- n 1)
                                 (+ acc
                                    (english-and n)))
                       ))))
    (e17-iter 1000 0)))

CL-USER> (e17)
21124

— Me@2023-10-26 06:36:38 PM

Euler problem 16.1

Posted on September 17, 2023 by rpflee

(defun digits (n)
  (labels
      ((f-iter (m acc)
         (cond ((= m 0) acc)
               ('t (f-iter (floor m 10)
                           (cons (mod m 10) acc))))))
    (f-iter n NIL)))

(defmacro sum (lst)
  `(reduce #'+ ,lst))

(sum (digits (expt 2 1000)))

— Me@2023-09-17 01:04:49 AM

Common Lisp calculator, 1

Posted on September 9, 2023 by rpflee

To run the following code, you have to install the Quicklisp library manager by following the steps in my blog post titled cmu-infix.

(ql:quickload :infix-math)

(asdf:load-system "infix-math/calc")

(infix-math/calc:calc)

This problem of using this calculator is that spaces are required both before and after an operator:

wrong:

1+1

correct:

1 + 1

— Me@2022-12-26 10:19:05 AM

Euler problem 15.1

Posted on August 27, 2023 by rpflee

— Poorly Drawn Lines

(defun factorial (n)
  (labels
      ((f-iter (m acc)
         (cond ((= m 0) acc)
               ('t (f-iter (1- m)
                           (* m acc))))))
    (f-iter n 1)))

(defun binomial (n r)
  (labels
      ((b-iter (m acc)
         (cond ((< m (1+ (- n r))) acc)
               ('t (b-iter (1- m)
                           (* m acc))))))
    (/ (b-iter n 1) (factorial r))))

— Me@2023-08-26 11:27:59 AM

Memoize

Posted on July 14, 2023 by rpflee

Euler problem 14.1.2

(defun range (max &key (min 0) (step 1))
  (loop :for n :from min :below max :by step
        collect n))

(defun max-item (lst)
  (loop :for item :in lst
        :maximize item))

(defmacro r-nth (n lst)
  `(nth (- (length ,lst) ,n) ,lst))

(defun collatz-length (n c)
  (cond ((= n 1) c) 
        ((evenp n) (collatz-length (/ n 2) (1+ c)))
        ('t (collatz-length (1+ (* 3 n)) (1+ c)))))

(defun memoize (fn)
  (let ((cache (make-hash-table :test #'equal)))
    #'(lambda (&rest args)
        (multiple-value-bind (val win)
            (gethash args cache)
          (if win
              val
              (setf (gethash args cache)
                    (apply fn args)))))))

(setf (fdefinition 'collatz-length)
      (memoize #'collatz-length))

(time (max-item (mapcar #'(lambda (x)
                            (collatz-length x 1))
                        (range 1000001 :min 1))))

;; Heap exhausted (no more space for allocation).
;; 109314048 bytes available, 171127632 requested.

;; PROCEED WITH CAUTION.
;;    [Condition of type
;;       SB-KERNEL::HEAP-EXHAUSTED-ERROR]

(time (max-item (mapcar #'(lambda (x)
                            (collatz-length x 1))
                        (range 250001 :min 1))))

;; Evaluation took:
;; 1.380 seconds of real time

(time (max-item (mapcar #'(lambda (x)
                            (collatz-length x 1))
                        (range 250001 :min 1))))

;; Evaluation took:
;; 0.068 seconds of real time

— Me@2023-07-14 02:54:38 PM

Shadow

Posted on July 4, 2023 by rpflee

Euler problem 14.1.1

(defun range (max &key (min 0) (step 1))
  (loop :for n :from min :below max :by step
        collect n))

(defun col (n c)
  (cond ((= n 1) c)     
        ((evenp n) (col (/ n 2) (1+ c)))
        ('t (col (1+ (* 3 n)) (1+ c)))))

(defun max-item (lst)
  (loop :for item :in lst
        :maximize item))

(defun e14 ()
  (let* ((c-lst
           (mapcar #'(lambda (x)
                       (col x 1))
                   (range 1000001 :min 1)))
         (max-len
           (max-item c-lst))
         (max-index
           (1+ (position max-len c-lst))))    
    (list max-index max-len)))

(time (e14))

;; Evaluation took:
;; 1.084 seconds of real time
  
;; (837799 525)

— Me@2023-07-03 12:33:40 AM

Quicklisp, 2

Posted on May 26, 2023 by rpflee

Euler problem 13

To run the following code, you have to install the Quicklisp library manager by following the steps in my blog post titled cmu-infix.

(ql:quickload "str")

(defun file-get-contents (filename)
  (with-open-file (stream filename)
    (let ((contents (make-string
                     (file-length stream))))
      (read-sequence contents stream)
      contents)))

(defun file-get-lines (filename)
  (with-open-file (stream filename)
    (loop :for line = (read-line stream nil)
          :while line
          :collect line)))

(file-get-lines #P"n.txt")

(defun string-to-list (the-string)
  (loop :for char :across the-string
        :collect char))

(defun char-to-integer-list (char-list)
  (mapcar #'digit-char-p char-list))

(let ((the-list (file-get-contents #P"n.txt")))
  (subseq
   (prin1-to-string
    (reduce
     #'+
     (mapcar
      #'parse-integer
      (butlast (str:split #\newline the-list)))))
   0 10))

— Me@2023-05-26 12:16:50 PM

MacBook Pro A1502

Posted on April 11, 2023 by rpflee

Euler problem 12.1.2

(defun good-reverse (lst)
  (labels ((rev (lst acc)
             (if (null lst)
                 acc
                 (rev
                  (cdr lst)
                  (cons (car lst) acc)))))
    (rev lst nil)))

(defparameter *primes* '(2 3 5))

(defun primeFactors (n)
  (factor-iter n *primes* '()))

(defun range (max &key (min 0) (step 1))
  (loop :for n :from min :below max :by step
        collect n))

(defun primep (x)
  (NULL (cdr (primeFactors x))))

(defun factor-iter (n 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)))
          ((NULL ps)
           (let* ((op
                    *primes*)
                  (num-extend
                    (range (1+
                            (ceiling (sqrt n)))
                           :min (+ p 2)
                           :step 2))
                  (primes-extend
                    (remove-if-not
                     #'primep
                     num-extend)))
             (if (NULL primes-extend)
                 (cons n acc-list)                
                 (progn
                   (setf *primes*
                         (append op primes-extend))
                   (factor-iter n
                                primes-extend
                                acc-list)))))
          ('t
           (factor-iter n ps acc-list)))))

(defmacro prime-filter (n)
  `(remove-if-not #'primep
                  (cons 2
                        (range (1+ ,n)
                               :min 3
                               :step 2))))

(time (length (prime-filter 20000000)))

;; Evaluation took:
;; 13.056 seconds of real time
 
;; 1270607

— Me@2023-03-28 11:51:24 AM

Euler problem 12.1.1

Posted on March 27, 2023 by rpflee

(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

Euler problem 10.1

Posted on February 21, 2023 by rpflee

Find the sum of all the primes below two million.

(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))))

(defun sum (lst)
  (reduce #'+ lst))

(sum (prime-sieve 2000000))

(time (sum (prime-sieve 2000000)))

— Me@2023-02-16 11:34:49 PM

cmu-infix

Posted on December 25, 2022 by rpflee

a library for writing infix mathematical notation in Common Lisp.

To install it:

1. In the Bash terminal, get Quicklisp by the following command:

sudo apt-get install cl-quicklisp

The file quicklisp.lisp will be created at

/usr/share/common-lisp/source/quicklisp/quicklisp.lisp

2. Run the command

sbcl --load /usr/share/common-lisp/source/quicklisp/quicklisp.lisp

3. Follow the install instructions:

(quicklisp-quickstart:install)

(ql:add-to-init-file)

4. To enable the library, in the Common Lisp REPL, run the code:

(ql:quickload :cmu-infix)

5. And then run:

(named-readtables:in-readtable cmu-infix:syntax)

6. To test the library, run:

(defmacro add (x y)
  `(let ((a ,x)
         (b ,y))
     #I(a+b)))

(add 2 3)

(macroexpand-1 '(add 2 3))

(macroexpand-1 '#I(1+2-3*5^^6))

(eval (macroexpand-1 '#I(1+2-3*5^^6)))

— Me@2022-12-25 10:13:04 AM

Pier, 2.2

Posted on December 5, 2022 by rpflee

Euler problem 9.1

There exists exactly one Pythagorean triplet for which a + b + c = 1000. Find the product abc.

(defun e9c ()
  (loop :for a :from 1 :to 1000 :do
    (loop :for b :from 1 :to a :do
      (let ((c (- 1000 (+ a b))))
        (if (= (+ (* a a) (* b b)) (* c c))
            (return-from e9c
                (list a b c (* a b c))))))))

— colorized by palette fm

— Me@2022-12-05 05:59:49 PM

ParEdit

Posted on November 29, 2022 by rpflee

(autoload 'enable-paredit-mode
  "paredit" "Turn on pseudo-structural editing." t)

(add-hook 'emacs-lisp-mode-hook
      #'enable-paredit-mode)

(add-hook 'eval-expression-minibuffer-setup-hook   
      #'enable-paredit-mode)

(add-hook 'ielm-mode-hook
      #'enable-paredit-mode)

(add-hook 'lisp-mode-hook
      #'enable-paredit-mode)

(add-hook 'lisp-interaction-mode-hook
      #'enable-paredit-mode)

(add-hook 'scheme-mode-hook
      #'enable-paredit-mode)


(add-hook 'slime-repl-mode-hook
      (lambda () (paredit-mode +1)))

(defun override-slime-repl-bindings-with-paredit ()
   (define-key slime-repl-mode-map
     (read-kbd-macro paredit-backward-delete-key) nil))

(add-hook 'slime-repl-mode-hook
      'override-slime-repl-bindings-with-paredit)

— Me@2022-11-29 10:03:49 PM

Pier, 1.2

Posted on November 12, 2022 by rpflee

Euler problem 8.1

73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450

Find the thirteen adjacent digits in the 1000-digit number that have the greatest product. What is the value of this product?

(defun file-get-contents (filename)
  (with-open-file (stream filename)
    (let ((contents (make-string
                     (file-length stream))))
      (read-sequence contents stream)
      contents)))

(defun file-get-lines (filename)
  (with-open-file (stream filename)
    (loop :for line = (read-line stream nil)
          :while line
          :collect line)))

(file-get-lines #P"n.txt")

(defun string-to-list (the-string)
  (loop :for char :across the-string
        :collect char))

(defun char-to-integer-list (char-list)
  (mapcar #'digit-char-p char-list))

(let ((the-digits (char-to-integer-list
           (string-to-list
            (remove #\newline
                    (file-get-contents #P"n.txt"))))))

  (loop :for i :from 0 :to (- (length the-digits) 13)
        :maximize (apply #'*
                    (subseq
                      the-digits i (+ i 13)))))