Add some function to sbcl

This commit is contained in:
Tom Willemse 2014-08-21 00:16:31 +02:00
parent e53667c7ee
commit 1774bb445d

View file

@ -46,24 +46,79 @@
(defun largest-prime-factor (number) (defun largest-prime-factor (number)
(apply #'max (prime-factors number))) (apply #'max (prime-factors number)))
(defun start-local-server () ;; (defun start-local-server ()
(ql:quickload "usocket") ;; (ql:quickload "usocket")
(usocket:socket-server ;; (usocket:socket-server
"localhost" 4006 ;; "localhost" 4006
(lambda (stream) ;; (lambda (stream)
(handler-case ;; (handler-case
(let ((*standard-input* stream) ;; (let ((*standard-input* stream)
(*standard-output* stream) ;; (*standard-output* stream)
(type (read stream))) ;; (type (read stream)))
(case type ;; (case type
(:eval ;; (:eval
(princ (eval (read))) ;; (princ (eval (read)))
(force-output)) ;; (force-output))
(:shell ;; (:shell
(loop ;; (loop
(fresh-line) ;; (fresh-line)
(princ "CL> " stream) ;; (princ "CL> " stream)
(force-output) ;; (force-output)
(print (eval (read))))))) ;; (print (eval (read)))))))
(end-of-file () nil))) ;; (end-of-file () nil)))
() :in-new-thread t :multi-threading t)) ;; () :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)))