56 lines
1.1 KiB
Common Lisp
56 lines
1.1 KiB
Common Lisp
;;;; decons
|
|
|
|
(defpackage :decons
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:util :scopes/util))
|
|
(:export #:*pi* #:area #:circle
|
|
#:absv #:double #:remainder
|
|
#:scalar-p #:tensor #:at
|
|
#:line
|
|
))
|
|
|
|
(in-package :decons)
|
|
|
|
;;;; basic explorations
|
|
|
|
(defconstant *pi* 3.14159)
|
|
|
|
(defclass circle ()
|
|
;;; ! implement as closure
|
|
((radius :accessor radius :initarg :radius :initform 1)))
|
|
|
|
(defgeneric area (c)
|
|
(:method ((c circle))
|
|
(* *pi* (radius c) (radius c))))
|
|
|
|
(defun double (f)
|
|
#'(lambda (v) (* 2 (funcall f v))))
|
|
|
|
(defun absv (v)
|
|
(if (< v 0) (- v) v))
|
|
|
|
(defun remainder (v d)
|
|
(if (< v d)
|
|
v
|
|
(remainder (- v d) d)))
|
|
|
|
;;;; library stuff
|
|
|
|
(defgeneric scalar-p (x)
|
|
(:method (x) t)
|
|
(:method ((x list)) nil)
|
|
(:method ((x array)) nil))
|
|
|
|
(defun tensor (s v)
|
|
(make-array s :initial-contents v))
|
|
|
|
(defun at (a &rest subs)
|
|
(apply #'aref a subs))
|
|
|
|
(defun (setf at) (v a &rest subs)
|
|
(setf (apply #'aref a subs) v))
|
|
|
|
;;;; parameterized functions
|
|
|
|
(defun line (x)
|
|
#'(lambda (theta) (+ (cadr theta) (* (car theta) x))))
|