Add some function to sbcl

1 files changed, 76 insertions, 21 deletions

diff --git a/sbcl/.sbclrc b/sbcl/.sbclrc
index 867959c..8b0dd56 100644
--- a/sbcl/.sbclrc
+++ b/sbcl/.sbclrc
@@ -46,24 +46,79 @@
 (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 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)))