legacy-dotfiles/sbcl/.sbclrc

;; -*- mode: lisp; -*-

;;; The following lines added by ql:add-to-init-file:
#-quicklisp
(let ((quicklisp-init (merge-pathnames ".local/share/quicklisp/setup.lisp"
                                       (user-homedir-pathname))))
  (when (probe-file quicklisp-init)
    (load quicklisp-init)))

(defun primep (number)
  (unless (= number 1)
    (let ((max (floor (sqrt number))))
      (or (= number 2)
          (and (not (evenp number))
               (= (length (loop for i from 3 upto max by 2
                             if (integerp (/ number i))
                             if (< 1 i number)
                             do (return-from primep nil)
                             else
                             collect i))
                  0))))))

(defun next-prime (number)
  (loop for i from (1+ number)
     if (primep i)
     return i))

(defun previous-prime (number)
  (loop for i from (1- number) downto 0
     if (primep i)
     return i))

(defun primes (number)
  (do ((prime 2 (next-prime prime))
       (primes (list)))
      ((> prime number) (reverse primes))
    (setf primes (cons prime primes))))

(defun prime-factors (number)
  (do ((i 1 (1+ i)))
      ((> i (/ number 2)) (list number))
    (let ((d (/ number i)))
      (if (and (integerp d) (primep i))
          (return (cons i (prime-factors d)))))))

(defun largest-prime-factor (number)
  (apply #'max (prime-factors number)))

;; (defun start-local-server ()
;;   (ql:quickload "usocket")
;;   (usocket:socket-server
;;    "localhost" 4006
;;    (lambda (stream)
;;      (handler-case
;;          (let ((*standard-input* stream)
;;                (*standard-output* stream)
;;                (type (read stream)))
;;            (case type
;;              (:eval
;;               (princ (eval (read)))
;;               (force-output))
;;              (:shell
;;               (loop
;;                  (fresh-line)
;;                  (princ "CL> " stream)
;;                  (force-output)
;;                  (print (eval (read)))))))
;;        (end-of-file () nil)))
;;    () :in-new-thread t :multi-threading t))

(defun reverse-number (num)
  (declare (optimize (debug 0)))
  (labels ((rev (num acc)
             (if (= num 0)
                 acc
                 (rev (floor (/ num 10))
                      (+ (* acc 10) (mod num 10))))))
    (rev num 0)))

(defun palindromic-number-p (num)
  (= num (reverse-number num)))

(defun largest-palindrome-product (num1 upper)
  (do* ((num2 upper (1- num2))
        (prod (* num1 num2) (* num1 num2)))
       ((palindromic-number-p prod) prod)))

(defun largest-palindrome-product-between (bounds)
  (do ((num1 (cdr bounds) (1- num1)) (prod 0))
      ((<= num1 (car bounds)) prod)
    (setf prod
          (max prod (largest-palindrome-product num1 (cdr bounds))))))

;; (defun prime-factors (num)
;;   (declare (optimize (debug 0)))
;;   (labels ((fact (num acc)
;;              (if (< num 2)
;;                  (reverse acc)
;;                  (do ((prime (next-prime 0) (next-prime prime)))
;;                      ((= (mod num prime) 0)
;;                       (fact (floor (/ num prime)) (cons prime acc)))))))
;;     (fact num nil)))

(defun smallest-multiple-between (bounds)
  (apply #'lcm (loop for i from (car bounds) to (cdr bounds) collect i)))

(defun square (num)
  (expt num 2))

(defun sum-of-squares (nums)
  (apply #'+ (mapcar #'square nums)))

(defun square-of-sums (nums)
  (square (apply #'+ nums)))

(defun sum-square-diff (bounds)
  (let ((nums (loop for i from (car bounds) upto (cdr bounds)
                 collect i)))
    (- (square-of-sums nums) (sum-of-squares nums))))

(defun nth-prime (num)
  (do* ((count 0 (1+ count))
        (prime 0 (next-prime prime)))
       ((>= count num) prime)))