Add some function to sbcl
This commit is contained in:
parent
e53667c7ee
commit
1774bb445d
1 changed files with 76 additions and 21 deletions
97
sbcl/.sbclrc
97
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)))
|
||||
|
|
Loading…
Reference in a new issue