legacy-dotfiles/sbcl/.sbclrc

124 lines
3.7 KiB
Common Lisp

;; -*- 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)))