exercises and notes from "Gentle introduction"
This commit is contained in:
efim
commit
067aebaf81
|
|
@ -0,0 +1,13 @@
|
|||
|
||||
;; exmple of FSM
|
||||
;; vending machine
|
||||
;; - gum :: 15 cents
|
||||
;; - mints :: 20 cents
|
||||
;; any combination of
|
||||
;; DIME - 10c
|
||||
;; NICKEL - 5c
|
||||
;; if enough money is in, press of either button would get you the product and change
|
||||
;; pressing coin return at any time will return amount equal to being put in so far
|
||||
|
||||
;;; and the exercise is to use macro to compile FSM with functions for states, from defstate & defarc structures
|
||||
;; that seems cool
|
||||
|
|
@ -0,0 +1,99 @@
|
|||
;;; applicative programming based on idea that functions are data
|
||||
;; base primitive is #'funcall
|
||||
|
||||
(funcall #'cons 'a 'b)
|
||||
(setf fn #'cons)
|
||||
fn
|
||||
(type-of fn)
|
||||
(funcall fn 'c 'd)
|
||||
|
||||
;; mapcar is most frequently used
|
||||
(defun power-3 (n)
|
||||
(* n n n))
|
||||
(power-3 3)
|
||||
|
||||
(mapcar #'power-3 '(1 2 3 4 5))
|
||||
|
||||
(mapcar (lambda (n) (* n n)) '(1 -1 4 -5))
|
||||
|
||||
(mapcar (lambda (name) `(hello there ,name)) '(john efim baba))
|
||||
|
||||
(quote thing)
|
||||
|
||||
(lambda (num) `(I like my number ,num))
|
||||
#'(lambda (num) `(I like my number ,num))
|
||||
|
||||
(defun flip (directions)
|
||||
(mapcar (lambda (direction)
|
||||
(cond ( (eq direction 'UP) 'DOWN)
|
||||
((eq direction 'DOWN) 'UP)
|
||||
(t 'UNKNOWN)))
|
||||
directions))
|
||||
|
||||
(flip '(UP UP UP DOWN))
|
||||
(flip '(UP UP UP DOWN heiho))
|
||||
|
||||
(< 1 5)
|
||||
|
||||
(defun find-first-around-10 (numbers number)
|
||||
(find-if (lambda (num) (if (< (abs (- num number)) 10) t)) numbers))
|
||||
|
||||
(find-first-around-10 '(100 150 149 200 ) 148) ; nice =D
|
||||
|
||||
(listp "hello")
|
||||
(listp '(1 2 ))
|
||||
(listp '())
|
||||
|
||||
(setf my-list '(1 2 "hhi"))
|
||||
(find-if #'listp '("hello" 12 my-list (1 2)))
|
||||
(find-if #'listp `("hello" 12 ,my-list (1 2)))
|
||||
;; cool, there's ' quote and ` backquote, which allows for , evaluation points
|
||||
|
||||
;; for shorter lambda, I guess I'd also want to learn big and common libraries
|
||||
;; like Alexandria, rutils, Serapeum, generic-cl
|
||||
;; https://lispcookbook.github.io/cl-cookbook/cl21.html#shorter-lambda
|
||||
|
||||
;;; reduce operation. single operation, without separate starting element, just whole list into single value
|
||||
(reduce #'+ '(1 2 3 15))
|
||||
(reduce #'+ nil) ; from left to right
|
||||
|
||||
;;; task of creating single set from list of lists.
|
||||
;; solution is to REDUCE and use UNION
|
||||
;; but hell, how would I remember, or found with apropos?
|
||||
;; there are set-* functions, but union is a separate name =C
|
||||
|
||||
(setf my-list-of-lists '((a b c) (c d a) (f b d) (g)))
|
||||
(reduce #'append my-list-of-lists)
|
||||
(reduce #'union my-list-of-lists)
|
||||
|
||||
;; well, there's sly-documentation - shows small doc
|
||||
;; and there's sly-documentation-lookup - directs to website with lots of info
|
||||
;; still not quite sure how would I have looked up union when it doesn't quite connect to set
|
||||
|
||||
;;; mapcar can take several lists and function of corresponding arity will be called with consequtive elements from those lists
|
||||
;;; as if they were zipped
|
||||
|
||||
(mapcar (lambda (name job) `(,name gets ,job))
|
||||
'(tom jerry simba)
|
||||
'(cleaning cooking roasting playing))
|
||||
|
||||
(setf words '((one . un)
|
||||
(two . du)))
|
||||
|
||||
(cdr (first words))
|
||||
|
||||
;; :from-end t - can be used with many applicative style funcions. Especially significant with REDUCE
|
||||
|
||||
;;; closure (as created in place of lambda creation)
|
||||
;;; has parent scope to the function.
|
||||
;;; basic parent is global scope
|
||||
|
||||
(defun make-greater-than-p (n)
|
||||
(lambda (x) (> x n)))
|
||||
|
||||
(setf my-pred (make-greater-than-p 5))
|
||||
|
||||
(funcall my-pred 3)
|
||||
(mapcar my-pred '(1 3 17 3))
|
||||
(find-if my-pred '(1 4 16 2 5))
|
||||
(delete-if my-pred '(2 5 17 3 6))
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
;;; constant timem to access
|
||||
|
||||
(make-array 5 :initial-element 1)
|
||||
(make-array 6 :initial-contents `(a e i o u j)) ; should match with size
|
||||
(make-array 3) ; elements are implementation dependent
|
||||
|
||||
*print-array*
|
||||
|
||||
;;; hash tables - more performant, but a bit more complicated api than alist
|
||||
(setf my-table (make-hash-table))
|
||||
(gethash 'a my-table)
|
||||
(setf (gethash 'a my-table) '(mary doctor))
|
||||
|
||||
;;; property list
|
||||
;; (ind-1 value-1 ind-2 value-2 ...)
|
||||
;; so all on one level instead of cons or lists
|
||||
;; GET function retrieves values from property list of a symbol.
|
||||
;; so first we put some properties to symbol
|
||||
(setf (get 'fred 'sex) 'male)
|
||||
(setf (get 'fred 'age) 33)
|
||||
(get 'fred 'sex)
|
||||
(describe 'fred) ; plist is printed in repl
|
||||
|
||||
(remprop 'fred 'age)
|
||||
|
||||
(symbol-plist 'fred)
|
||||
|
||||
(defun subprop (symbol item property)
|
||||
(setf (get symbol property)
|
||||
(remove item (get symbol property)))) ; well that's exercise for lisp properties, ok
|
||||
|
||||
(setf (get 'fred 'syblings) '(jeorge tom))
|
||||
(get 'fred 'syblings)
|
||||
(subprop 'fred 'tom 'syblings)
|
||||
|
||||
;; allright, let's do exercise about random and histogram
|
||||
;;
|
||||
;; (new-histogram 11)
|
||||
;; (dotimes 200
|
||||
;; (record-value (random 11)))
|
||||
;; (print-histogram)
|
||||
|
||||
(defvar *hist-array*)
|
||||
(defvar *total-points*)
|
||||
|
||||
(defun new-histogram (size)
|
||||
(setf *hist-array* (make-array size :initial-element 0))
|
||||
(setf *total-points* 0))
|
||||
|
||||
(new-histogram 11)
|
||||
|
||||
(length *hist-array*)
|
||||
(aref *hist-array* 1)
|
||||
(incf (aref *hist-array* 1))
|
||||
|
||||
(defun record-value (n)
|
||||
"Adds value h to corresponding bucket of *HIST-ARRAY* and increases *TOTAL-POINTS*."
|
||||
(if (> n (length *hist-array*)) (error "nubmer is too big"))
|
||||
(incf (aref *hist-array* n))
|
||||
(incf *total-points*))
|
||||
|
||||
;; next - print
|
||||
|
||||
(defun print-hist-line (i)
|
||||
(let* ((hist-value (aref *hist-array* i))
|
||||
(hist-line (make-string hist-value :initial-element #\*)))
|
||||
(format t "~&~2S [ ~3S] ~S" i hist-value hist-line)))
|
||||
|
||||
(dotimes (i 200)
|
||||
(record-value (random (length *hist-array*))))
|
||||
|
||||
(print-hist-line 2)
|
||||
|
||||
(defun print-histogram ()
|
||||
(dotimes (i (length *hist-array*))
|
||||
(print-hist-line i)))
|
||||
|
||||
(print-histogram)
|
||||
|
||||
;;; yay!
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
|
||||
(setf circ (list 'foo))
|
||||
(setf (cdr circ) circ)
|
||||
|
||||
circ
|
||||
|
||||
;;; setf modifies "pointers"
|
||||
;;; and getter returns a reference
|
||||
;;; so using setf with getter as "place" works as a setter
|
||||
;;;
|
||||
;;; append - nondestructive
|
||||
;;; nconc - destructive merging of lists
|
||||
|
||||
(nconc '(hello lists) '("and" "with" other 15 "values"))
|
||||
|
||||
;; subst - nondesctructive
|
||||
;; nsubst - destructive
|
||||
|
||||
(setf tree '(i say (e i (e i) o)))
|
||||
(subst 'a 'e tree)
|
||||
tree
|
||||
|
||||
(nsubst 'a 'e tree)
|
||||
(nsubst 'cherry '(a i) tree :test #'equal)
|
||||
;; this modifies the list
|
||||
|
||||
;;; exercise,
|
||||
;; chop - redule non nil list to list of head
|
||||
(defun chop (x)
|
||||
(setf (cdr x) nil))
|
||||
|
||||
(setf my-list '(1 2 "hello"))
|
||||
(chop my-list)
|
||||
my-list
|
||||
|
||||
(defun ntack (x a)
|
||||
(setf (cdr (last x)) (list a)))
|
||||
(setf my-test-ntack-list '(1 2 "hello"))
|
||||
(ntack my-test-ntack-list 'boo)
|
||||
my-test-ntack-list
|
||||
|
||||
;; and more recursion
|
||||
(setf h '(hi ho))
|
||||
(setf (cdr (last h)) h)
|
||||
|
||||
;;; setq - before "generalized variables", only sets value of ordinary variables
|
||||
(setq x '(slings and arrows))
|
||||
(setq (cdr x) (list "hello")) ; variable name is not a symbol
|
||||
|
|
@ -0,0 +1,365 @@
|
|||
(FIRST '(5 2 3))
|
||||
(SECOND '(5 2 3))
|
||||
(THIRD '(5 2 3))
|
||||
(REST '(5 2 3 5 1 6))
|
||||
|
||||
(cons 1 '( 2 )) ; adds number to the list
|
||||
(cons 1 2) ; just a cons element
|
||||
(cons 'SINK '(OR SWIM)) ; adds symbol to the list
|
||||
(cons 'SINK 'SWIM) ; just a cons element with symbols
|
||||
(cons 'start nil) ; list is when last cons ends with `nil
|
||||
(cons 'start (cons 'end nil)) ; if we are to construct list from cons cells (and not from print notation)
|
||||
(cons 'nil 'nil) ; putting nil into CDR means having list with that item as CAR
|
||||
(cons '(PHONE HOME) nil)
|
||||
;; even though `nil is same as '() many properties of lists hold only for non-empty lists, i.e
|
||||
;; with at least one cons cell
|
||||
;; for example main relationship between CAR, CDR & CONS
|
||||
(equal
|
||||
'(1 2 3 4)
|
||||
(cons
|
||||
(car '(1 2 3 4))
|
||||
(cdr '(1 2 3 4))))
|
||||
;; doesn't work for () :
|
||||
(equal
|
||||
'()
|
||||
(cons
|
||||
(car '())
|
||||
(cdr '())))
|
||||
|
||||
(cons
|
||||
(car '())
|
||||
(cdr '())) ; => (NIL)
|
||||
|
||||
;;; exercises 3
|
||||
(defun half (x)
|
||||
(/ x 2))
|
||||
|
||||
(defun cube (x)
|
||||
(* x x x))
|
||||
|
||||
(defun pythag (x y)
|
||||
(sqrt (+ (* x x) (* y y))))
|
||||
|
||||
;; variables /are named by/ symbols, they are *not* symbols
|
||||
;; funcitons are /aldo named by/ symbols
|
||||
|
||||
;;; symbols and lists as data
|
||||
;; use ` - tilde to tell lisp interpreter
|
||||
;; to treat symbol not as a name for variable (and evaluate to its value)
|
||||
;; but to treat it as symbol (data)
|
||||
;;
|
||||
;; most symbols need to be quoted to be treated as symbols
|
||||
;; some exceptions are t and nil which are self evaluating
|
||||
|
||||
(defun riddle (x y)
|
||||
(list `why `is `a x `like `a y))
|
||||
(riddle `raven `desk)
|
||||
|
||||
;;; Evaluation Rule for quoted Quoted Objects:
|
||||
;;; quoted object evaluates to the object itself without the quote
|
||||
|
||||
;; 3 ways of creating lists
|
||||
`(foo bar baz) ; everything inside list is not evaluated
|
||||
|
||||
(list `foo `bar `baz (* 33 33)) ; allows for "computed elements"" "
|
||||
(cons `foo `(bar baz))
|
||||
|
||||
;; 3.11
|
||||
(defun longer-than (l1 l2)
|
||||
(> (length l1) (length l2)))
|
||||
|
||||
(defun call-up (caller callee)
|
||||
(list `hello callee `this `is caller `calling))
|
||||
|
||||
(defun crank-call (caller callee)
|
||||
`(hello callee this is caller calling))
|
||||
|
||||
;; 3.22 c
|
||||
(defun myfun (a b)
|
||||
(list (list a) b))
|
||||
|
||||
;; 3.22 d
|
||||
(defun firstp (item list)
|
||||
(equal item (first list)))
|
||||
|
||||
;; 3.22 e
|
||||
(defun mid-add1 (list)
|
||||
(cons
|
||||
(car list)
|
||||
(cons (+ 1 (cadr list))
|
||||
(cddr list))))
|
||||
|
||||
;; 33.2 f
|
||||
(defun f-to-c (farenheit-temp)
|
||||
(/ (* 5 (- farenheit-temp 32)) 9))
|
||||
|
||||
(symbol-name `equal)
|
||||
(symbol-function `equal)
|
||||
|
||||
(symbol-name `lambda)
|
||||
(symbol-function `lambda)
|
||||
|
||||
(eval (list `cons t nil))
|
||||
|
||||
;;; equivalence of COND, IF, AND & OR - conditionals
|
||||
|
||||
;; (and x y z w)
|
||||
|
||||
;; (equal 1 1 1)
|
||||
|
||||
(setq
|
||||
x 1
|
||||
y nil
|
||||
z 1
|
||||
w 1)
|
||||
|
||||
(cond
|
||||
((not x) nil)
|
||||
((not y) nil)
|
||||
((not z) nil)
|
||||
((not w) nil)
|
||||
(t t))
|
||||
|
||||
(defun boilingp (temp scale)
|
||||
(cond ((and (equal scale `celsius)
|
||||
(> temp 100)) t)
|
||||
((and (equal scale `farenheit)
|
||||
(> temp 212)) t)))
|
||||
|
||||
(defun boilingp-2 (temp scale)
|
||||
(or
|
||||
(and (equal scale `celsius) (> temp 100))
|
||||
(and (equal scale `farenheit) (> temp 212))))
|
||||
|
||||
(cond)
|
||||
|
||||
;; 4.28
|
||||
(if (oddp 5) (evenp 7) `foo)
|
||||
(or (and (oddp 5) (evenp 7)) `foo)
|
||||
;; not sure what's up with that
|
||||
;; was that attempt to rewrite if into or&and?
|
||||
;; So, that written correctly! I get stops because of forced debugger!
|
||||
;; (step (eval (or (and (oddp 5) `(evenp 7)) ``foo)))
|
||||
(eval `(evenp 7))
|
||||
(eval ``foo)
|
||||
|
||||
|
||||
(step (if (oddp 5) `yes `no))
|
||||
|
||||
(defun my-abs (x)
|
||||
(if (< x 0) (- x) x))
|
||||
|
||||
(step (my-abs 15))
|
||||
|
||||
;;; variables & side-effects
|
||||
(defun price-change (old new)
|
||||
(let* ((diff (- new old))
|
||||
(proportion (/ diff old))
|
||||
(percentage (* proportion 100.0)))
|
||||
(list `widgets `changed `by percentage `percent)))
|
||||
|
||||
;;; 5.6 die exercise
|
||||
(defun throw-die ()
|
||||
"Return random value [1 6]."
|
||||
(+ 1 (random 6)))
|
||||
|
||||
(defun throw-dice ()
|
||||
"Return list of 2 random die trows"
|
||||
(list (throw-die)
|
||||
(throw-die)))
|
||||
|
||||
(defun snake-eyes-p (throw)
|
||||
"True if both dice in throw equal to 1."
|
||||
(and (equal 1 (first throw))
|
||||
(equal 1 (second throw))))
|
||||
|
||||
(defun boxcars-p (throw)
|
||||
"True if both dice in throw equal to 6."
|
||||
(and (equal 6 (first throw))
|
||||
(equal 6 (second throw))))
|
||||
|
||||
(defun instant-win-p (throw)
|
||||
"True if sum of dice in throw is 7 or 11"
|
||||
(let ((sum (+ (first throw) (secon throw)))
|
||||
(special-values (list 7 11)))
|
||||
nil))
|
||||
|
||||
;; they meant type of word that is an article
|
||||
(setq articles `(the a an))
|
||||
(defun contains-article-p-1 (list)
|
||||
"Check whether article contains in the list."
|
||||
(intersection articles list))
|
||||
|
||||
(setq test-sentence `(we will rock the boat))
|
||||
|
||||
;; checks for each article
|
||||
(mapcar (lambda (article)
|
||||
(member article test-sentence)
|
||||
) articles)
|
||||
|
||||
;; attempt to fold them into single boolean with or
|
||||
(apply `or (mapcar (lambda (article)
|
||||
(member article test-sentence)
|
||||
) articles))
|
||||
|
||||
(step (apply `+ `(1 2 3)))
|
||||
(apply `equal `(2 3))
|
||||
(equal 2 3)
|
||||
(or nil nil t)
|
||||
(apply `or `( nil nil t))
|
||||
(step (apply `or (list nil nil nil)))
|
||||
|
||||
(setq comparing-sentence `(large red shiny kube -vs- small shiny red four-sided pyramid))
|
||||
|
||||
(list
|
||||
(length (intersection
|
||||
(cdr (member `-vs- comparing-sentence))
|
||||
(cdr (member `-vs- (reverse comparing-sentence)))))
|
||||
`common `features)
|
||||
|
||||
;;; 6.9 programming with tables (as lists)
|
||||
(setq table1 `((object1 large green shiny cube)
|
||||
(object2 small wihte dull cube)
|
||||
(object3 large red shiny pyramid)
|
||||
(object3 green shiny sphere)))
|
||||
|
||||
(setf quality-table
|
||||
`((green . color)
|
||||
(red . color)
|
||||
(white . color)
|
||||
(cube . shape)
|
||||
(pyramid . shape)
|
||||
(sphere . shape)
|
||||
(shiny . luster)
|
||||
(dull . luster)
|
||||
(large . size)
|
||||
(small . size)
|
||||
))
|
||||
|
||||
(defun quality (x)
|
||||
"Get from hardcoded table."
|
||||
(cdr (assoc x quality-table))
|
||||
)
|
||||
|
||||
(defun description (key)
|
||||
"Get description of object from hardcoded table."
|
||||
(cdr (assoc key table1)))
|
||||
|
||||
(description `object2)
|
||||
;; notion of ~sublis~ function instead of mapcar for getting types of properties
|
||||
|
||||
(defun differences (x y)
|
||||
"Get different properties from hardcoded table."
|
||||
(set-exclusive-or (description x)
|
||||
(description y)))
|
||||
|
||||
(differences `object1 `object2)
|
||||
|
||||
|
||||
(remove-duplicates (sublis quality-table (differences `object1 `object2)))
|
||||
|
||||
;;; 6.35 finite state automata
|
||||
|
||||
(setq nerd-states `((sleeping . eating)
|
||||
(eating . waiting-for-a-computer)
|
||||
(waiting-for-a-computer . programming)
|
||||
(programming . debugging)
|
||||
(debugging . sleeping)))
|
||||
|
||||
(defun nerdus (current-state)
|
||||
"Return next state for the nerdus in the provided CURRENT-STATE."
|
||||
(cdr (assoc current-state nerd-states)))
|
||||
|
||||
(nerdus `programming)
|
||||
|
||||
(defun sleepless-nerd (current-state)
|
||||
"Nerd that never sleeps."
|
||||
;; consequtive `sleep -> sleep` considered to be impossible
|
||||
(let ((possible-state (nerdus current-state)))
|
||||
(if (equal possible-state `sleeping)
|
||||
(nerdus `sleeping) possible-state)))
|
||||
|
||||
(sleepless-nerd `sleeping)
|
||||
(sleepless-nerd `debugging)
|
||||
|
||||
(nerdus `playing-guitar)
|
||||
|
||||
(defun nerd-on-caffeine (current-state)
|
||||
"Advancing two states in one step."
|
||||
(nerdus (nerdus current-state)))
|
||||
|
||||
(nerd-on-caffeine `sleeping)
|
||||
|
||||
;; nested lists are trees and there are functions that can be used on them
|
||||
(subst `bb `aa `(In this list symbol aa would be substituted))
|
||||
;; args are NEW OLD TREE
|
||||
;; and whole tree structure is checked:
|
||||
|
||||
(subst `bb `a `((a tree) In this list symbol (a hatter) aa would be substituted (a test)))
|
||||
|
||||
;; sublis takes many substitutions, instead of first two args, the plist
|
||||
(defun royal-we (sentence)
|
||||
"Substitute all I to We."
|
||||
(subst `we `i sentence))
|
||||
|
||||
;;; eq compares addresses, so lists would not be eq
|
||||
;;; equal compares elements of the lists
|
||||
;; symbols are singletons, so using ~eq~ is ok
|
||||
;; numbers might not be primitive in lisp implementations!
|
||||
;;
|
||||
;; eql - compares addresses in general case, for numbers: if of the same type compares values
|
||||
(eql 3 3)
|
||||
(eql 3 3.0)
|
||||
;; to test value of the numbers across types
|
||||
;; but works only with numbers, ok!
|
||||
(= 3 3.0)
|
||||
|
||||
|
||||
;;; Keyword arguments
|
||||
:keyword-symbol ; evaluates to self, cannot change value
|
||||
keyword-symbol ; different and not equal to actual keyword
|
||||
(symbolp :keyword)
|
||||
(keywordp :keyword)
|
||||
(keywordp `keyword)
|
||||
|
||||
;;; 7.3 Applicative programming
|
||||
;; one of the styles, along with recursive and iterative
|
||||
|
||||
(funcall #'cons 'a 'b)
|
||||
(setf fn #'cons)
|
||||
fn
|
||||
(type-of fn)
|
||||
(funcall fn 'c 'd)
|
||||
|
||||
;; using mapcar
|
||||
(defun squaring (x)
|
||||
"Square input."
|
||||
(* x x))
|
||||
(squaring 9)
|
||||
(squaring '(1 2 2 3))
|
||||
|
||||
(mapcar #'squaring '(1 2 2 3 9))
|
||||
|
||||
(mapcar #'zerop '(20 340 0 -5 -6))
|
||||
|
||||
(mapcar #'(lambda (x) `(hi there ,x))
|
||||
'(joe fred martha))
|
||||
;; 195
|
||||
(funcall #'(lambda (x)
|
||||
(or (equal x t)
|
||||
(equal x nil))) 1)
|
||||
|
||||
(defun half (x)
|
||||
""
|
||||
(/ x 2.0))
|
||||
|
||||
(defun average (x y)
|
||||
""
|
||||
(+ (half x) (half y)))
|
||||
|
||||
(defun fact (n)
|
||||
""
|
||||
(cond ((zerop n) 1)
|
||||
(t (* n (fact (- n 1))))))
|
||||
|
||||
(fact 4)
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
|
||||
(defun analyze-profit (price comission-rate)
|
||||
(let* ((comission (* price comission-rate))
|
||||
(result (cond ((> 100 comission) 'rich)
|
||||
((< 100 comission) 'poor))))
|
||||
(break "~&The value of result is ~S" result)
|
||||
(format t "~&I predict that you will be: ~S" result)
|
||||
result))
|
||||
|
||||
(analyze-profit 2200 0.06)
|
||||
(analyze-profit 2000 0.05)
|
||||
|
||||
;;; So - debugger keys and functions
|
||||
;; C-j and C-k are for moving between frames
|
||||
;; for frame context commands R - return from frame with particular value (sly-db-return-from-frame)
|
||||
;; x - step over, s - step
|
||||
;; e - eval in frame, i - inspect in frame (show additional info on evaluated value)
|
||||
;; RET - toggle details for current frame
|
||||
;; v - show frames code
|
||||
;; d - pretty-print-eval-in-frame
|
||||
;; (searching all of functions by going into debugger bugger and looking at *helpful* (C-h C-f) "sly-db-"
|
||||
|
||||
;; could also try to recompile thing, maybe r for restart, or R to return with value 1 from last frame and check how it all works
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
(defun hello ()
|
||||
(write-line "What is your name?")
|
||||
(let ((name (read-line)))
|
||||
(format t "Hello, ~A.~%" name)))
|
||||
|
|
@ -0,0 +1,117 @@
|
|||
;;; that's chapter 9
|
||||
(format t "hello")
|
||||
|
||||
;; so here's difference with Elisp, format takes "destination" as first attribute
|
||||
;; needs 't to write to screen, others to file or such
|
||||
;; in Elisp returns a string, right? yes
|
||||
|
||||
(format t "~&There are old pilots,~&and there are bold pilots,~&but there are no bold old pilots.")
|
||||
|
||||
(defun draw-line (n)
|
||||
(cond ((zerop n) (format t "~%"))
|
||||
(t (format t "*")
|
||||
(draw-line (- n 1)))))
|
||||
|
||||
(draw-line 5)
|
||||
|
||||
(defun draw-box (height width)
|
||||
(cond ((zerop height) (format t "~%"))
|
||||
(t (draw-line width)
|
||||
(draw-box (- height 1) width))))
|
||||
|
||||
(draw-box 3 15)
|
||||
|
||||
(defun draw-ttt-row (row)
|
||||
(labels ((as-drawable (cell-state)
|
||||
(if (null cell-state) " "
|
||||
cell-state)))
|
||||
(format t "~&~A|~A|~A~%" (as-drawable (first row)) (as-drawable (second row)) (as-drawable (third row)))))
|
||||
|
||||
(draw-ttt-row '(X O nil))
|
||||
|
||||
(defun draw-ttt-board (table)
|
||||
(draw-ttt-row (first table))
|
||||
(format t "-----~%")
|
||||
(draw-ttt-row (second table))
|
||||
(format t "-----~%")
|
||||
(draw-ttt-row (third table)))
|
||||
|
||||
(draw-ttt-board '( (x x nil) (nil o nil) (x o x)))
|
||||
|
||||
;;; the read function
|
||||
|
||||
(defun my-square ()
|
||||
(format t "Please type in a number: ")
|
||||
(let ((x (read)))
|
||||
(format t "~&The number ~S squared is: ~S" x (* x x))))
|
||||
|
||||
(my-square)
|
||||
|
||||
(defun test-y-or-n ()
|
||||
(if (yes-or-no-p "~&Answer yes or no")
|
||||
(format t "~&this is the yes response")
|
||||
(format t "~&this is no response")))
|
||||
|
||||
(test-y-or-n)
|
||||
|
||||
;; reading from the file
|
||||
|
||||
(defun get-tree-data (path-string)
|
||||
(with-open-file (stream path-string) ; both absolute from ~ and relative work
|
||||
(let* ((tree-loc (read stream))
|
||||
(tree-table (read stream))
|
||||
(num-trees (read stream)))
|
||||
(format t "~&There are ~S trees on ~S." num-trees tree-loc)
|
||||
(format t "~&They are ~S" tree-table))))
|
||||
|
||||
(get-tree-data "./test-input.lisp") ; cool
|
||||
|
||||
;; so just dumped elisp structures can be extracted
|
||||
;; that is very very convenient
|
||||
|
||||
(defun save-tree-data (tree-loc tree-table num-trees)
|
||||
(with-open-file (stream "/usr/tmp/test-lisp-data.lisp" :direction :output)
|
||||
(format stream "~S~%" tree-loc)
|
||||
(format stream "~S~%" tree-table)
|
||||
(format stream "~S~%" num-trees)))
|
||||
|
||||
(save-tree-data "Tbilisi" '((45 redwood) (22 oak) (43 maple)) 110)
|
||||
|
||||
(get-tree-data "/usr/tmp/test-lisp-data.lisp")
|
||||
|
||||
;;; exercise - drawing graph of arbitrary function
|
||||
(defun draw-y (y point)
|
||||
(format t "~&")
|
||||
(format t (concatenate 'string (make-string y :initial-element #\ ) point)))
|
||||
|
||||
(defun make-graph ()
|
||||
(let ((requested-function (progn
|
||||
(format t "~&Function to graph?")
|
||||
(read)))
|
||||
(start-value (progn
|
||||
(format t "~&Starting x value?")
|
||||
(read)))
|
||||
(end-value (progn
|
||||
(format t "~&Ending x value?")
|
||||
(read)))
|
||||
(plotting-string (progn
|
||||
(format t "~&Plotting string?")
|
||||
(read))))
|
||||
|
||||
(loop for x from start-value to end-value
|
||||
do (draw-y (funcall requested-function x) plotting-string))))
|
||||
|
||||
(defun square (n)
|
||||
(* n n))
|
||||
(square 7)
|
||||
|
||||
(funcall #'square 4)
|
||||
|
||||
(make-graph)
|
||||
|
||||
;; yups
|
||||
|
||||
(draw-y 5 "****")
|
||||
|
||||
(concatenate 'string (make-string 10 :initial-element #\ ) ".")
|
||||
(concatenate 'string "hello" " " "who")
|
||||
|
|
@ -0,0 +1,98 @@
|
|||
;; (dotimes (index-var n [result-form]
|
||||
;; body)
|
||||
;;
|
||||
;; (dolist (index-var n [result-form]
|
||||
;; body)
|
||||
;;
|
||||
;; result for is a thing to return, but is that joined from iterations?
|
||||
(dotimes (x 5 `(list ,x))
|
||||
(format t "~&iterating ~S" x))
|
||||
|
||||
;; i guess that's from the last
|
||||
|
||||
(dolist (x '(red blue green) 'x)
|
||||
(format t "~&Roses are ~S" x)
|
||||
(if (equal x 'blue) (return x)))
|
||||
|
||||
;;; so [result-form] is returned if iteration reaches the end
|
||||
|
||||
(assoc 'key1 '((key1 . value1) (key2 . "hello")))
|
||||
(assoc 'key1 '((key1 value1) (key2 "hello")))
|
||||
|
||||
;;; applicative squaring with mapcar are simpler
|
||||
;;; for the iterative, first get local variable around list, and return statement reverse it
|
||||
(defun it-square-list (x)
|
||||
(let ((result nil))
|
||||
(dolist (i x (reverse result))
|
||||
(push (* i i) result))))
|
||||
|
||||
(it-square-list '(1 2 4 10))
|
||||
|
||||
;; the DO macro is "most powerful" iteration in CL
|
||||
|
||||
;; (DO ((var1 init1 [update1])
|
||||
;; (var2 init2 [update2]))
|
||||
;; (test action1 action2 ... action-n)
|
||||
;; body)
|
||||
|
||||
;; so, vars might not have update expressions
|
||||
;; first assing vars, evaluate test, if test - to exit - evaluate end actions
|
||||
;; if not test - evaluate body, then run updates to variables and repeat
|
||||
|
||||
(defun launch (n)
|
||||
(do ((cnt n (- cnt 1)))
|
||||
((zerop cnt) (format t "Blast off!~&"))
|
||||
(format t "~S..." cnt)))
|
||||
|
||||
(launch 10)
|
||||
(launch 20)
|
||||
|
||||
;; would be cool to find some kind of 2/3 dimentinal problem to be solved clearly with DO
|
||||
;; like walking aroung the array
|
||||
|
||||
;; also - body can have (return [value]) expressions!
|
||||
;; so nil can be exit expression, for infinite iteration
|
||||
|
||||
(defun read-a-number ()
|
||||
(do ((answer nil))
|
||||
(nil)
|
||||
(format t "~&Please input a number: ")
|
||||
(setf answer (read))
|
||||
(if (numberp answer) (return answer)
|
||||
(format t "~&Sorry, ~S is not a number. Try again." answer))))
|
||||
|
||||
;;; Blocks.
|
||||
;; implicit blocks are bodies of function, with function name being a block name
|
||||
;; and RETURN-FROM can be used to exit block
|
||||
;; DO, DOLIST, DOTIMES are wrapped with block with name nil, so RETURN is just RETURN-FROM nil
|
||||
;; but we can to return from function, short circuiting
|
||||
|
||||
(defun my-square-list (x)
|
||||
(mapcar (lambda (i)
|
||||
(if (numberp i) (* i i)
|
||||
(return-from my-square-list `nope))) x))
|
||||
|
||||
(my-square-list '(1 2 51 4))
|
||||
(my-square-list '(1 3 5 "hello" 4))
|
||||
|
||||
;; and can create explicitly with BLOCK function?
|
||||
;; and use RETURN-FROM from inside that block? what about from inside functions that are called in the block?
|
||||
|
||||
(defun print-and-exit-my-block ()
|
||||
(format t "~&in the function")
|
||||
(return-from my-block))
|
||||
|
||||
(block my-block
|
||||
(format t "~&Entering my block")
|
||||
(print-and-exit-my-block) ; gets error - unknown block, so YAY
|
||||
(format t "~&After calling function in my block"))
|
||||
|
||||
;;; Exercise
|
||||
;;; about dna things
|
||||
|
||||
|
||||
|
||||
;; progn, prog1, prog2
|
||||
;; prog1 returns value of first expression
|
||||
;; prog2 -//- of second expression
|
||||
;; progn -//- of last
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
;;; missimetry of cons and bracketed list
|
||||
(cons 16 (list 1 2 3))
|
||||
(cons (list 1 2 3) 5)
|
||||
|
||||
;; so adding to front is easy,
|
||||
;; adding to back is hard, since last element connected to nil
|
||||
|
||||
(last `(1 2 3 4)) ; => (4)
|
||||
|
||||
;; for sets:
|
||||
;; member, union, intersection, set-difference, subsetp
|
||||
|
||||
;; stopped at exercise 6.26 (i remember reading that in the court hallway)
|
||||
|
||||
;;; tables / alists
|
||||
|
||||
(setf words '((one un)
|
||||
(two deu)
|
||||
(three trois)
|
||||
(four quatre)
|
||||
(five cing)))
|
||||
|
||||
(assoc 'three words)
|
||||
(cdr '(one un))
|
||||
(rassoc '(un) words) ; why not found?
|
||||
|
||||
(setf sounds '((cow . moo)
|
||||
(pig . oink)
|
||||
(cat . meow)
|
||||
(dog . woof)
|
||||
(bird . tweet)))
|
||||
|
||||
(rassoc 'moo sounds)
|
||||
|
||||
;;; keyword arguments...
|
||||
(setf text `(b a n a n a - p a n d a))
|
||||
text
|
||||
|
||||
(remove `a text)
|
||||
(remove `a text :count 3)
|
||||
(remove `a text :count 2 :from-end t)
|
||||
|
||||
;; keyword is symbol with : at the start of the name
|
||||
(keywordp ':hello)
|
||||
(keywordp :hello) ; no need to quote?
|
||||
(keywordp 'hello)
|
||||
|
||||
;; trees, subst & sublis ?
|
||||
;; performing substitutions from alist into tree (?)
|
||||
;;; subst - substitute X for Y in Z
|
||||
(subst 'the 'a '(a list even nested (a hare) will get a substitution))
|
||||
|
||||
;;; sublis - takes make substitutions at same time
|
||||
;; and it takes which? alisp plist? urgh
|
||||
;; in emacs - plist is one level list
|
||||
;; alist - list of cons cells
|
||||
;; here also 2 level list is alist, and what's expected
|
||||
(sublis '((rose . red) (violet . blue) (sunflower . yellow))
|
||||
'(here is the rose strucure (another rose and violet thingy) multilevel))
|
||||
|
||||
;; I suppse could be used on "code as data"
|
||||
|
|
@ -0,0 +1,200 @@
|
|||
|
||||
(setf a 0)
|
||||
|
||||
(incf a)
|
||||
|
||||
(macroexpand-1 '(incf a))
|
||||
|
||||
(macroexpand-1 '(pop x))
|
||||
|
||||
(macroexpand-1 '(defstruct starship
|
||||
(name nil)
|
||||
(condition 'green)))
|
||||
|
||||
(defmacro simple-incf (a)
|
||||
(list 'setq a (list '+ a 1)))
|
||||
|
||||
(simple-incf a)
|
||||
|
||||
;;; difference with a function
|
||||
(defun faulty-incf (a)
|
||||
(setq a (+ a 1)))
|
||||
|
||||
(faulty-incf a)
|
||||
|
||||
;; for function call 'a is being evaluated to 10, and bound to a local variable
|
||||
;; then we change value of that local variable, but external is not affected
|
||||
;;
|
||||
;; in macros, symbol a is not evaluated, and inserted into a lisp expression,
|
||||
;; that ultimately changes value of the correct variable
|
||||
|
||||
;;; backquote, allows for dequoting with ,
|
||||
`(hello ,a world! quoted (+ 10 1 2) unquoted ,(+ 10 1 2))
|
||||
|
||||
;; exercise
|
||||
(defmacro set-mutual (a b)
|
||||
`(progn
|
||||
(setq ,a ',b)
|
||||
(setq ,b ',a)))
|
||||
|
||||
(set-mutual yo hei)
|
||||
yo
|
||||
hei
|
||||
|
||||
(set-mutual val1 val2)
|
||||
|
||||
(defun f (x y)
|
||||
(showvar x)
|
||||
(showvar y)
|
||||
(* x y))
|
||||
|
||||
(defmacro showvar (x)
|
||||
`(format t "~&Value of ~S is ~S" ',x ,x))
|
||||
(showvar yo)
|
||||
|
||||
(f 15 4)
|
||||
|
||||
;;; Splicing with backquote
|
||||
|
||||
(setf name 'fred)
|
||||
(setf address '(16 maple drive))
|
||||
|
||||
`(,name lives in ,address now) ; inserting
|
||||
;; => (FRED LIVES IN (16 MAPLE DRIVE) NOW)
|
||||
|
||||
`(,name lives in ,@address now) ; splicing
|
||||
;; => (FRED LIVES IN 16 MAPLE DRIVE NOW)
|
||||
|
||||
;; example of usage
|
||||
(defmacro set-zero (&rest variables)
|
||||
`(progn ,@(mapcar #'(lambda (var)
|
||||
(list 'setf var 0))
|
||||
variables)
|
||||
'(zeroed ,@variables)))
|
||||
|
||||
(set-zero a b c d)
|
||||
|
||||
(defmacro variable-chain (&rest variables)
|
||||
`(progn ,@(mapcar #'(lambda (first second)
|
||||
`(setq ,first ',second))
|
||||
variables
|
||||
(rest variables))))
|
||||
|
||||
;; i even like my solution more thatn one in the book, with DO
|
||||
|
||||
(variable-chain a b c d)
|
||||
|
||||
(setf my-test-variables '(a b c d))
|
||||
(mapcar (lambda (first second) (setf first second))
|
||||
my-test-variables
|
||||
(rest my-test-variables))
|
||||
|
||||
;;; Compilation
|
||||
'(you can use #'compile and #'compile-file)
|
||||
|
||||
(defun tedious-sqrt (n)
|
||||
(dotimes (i n)
|
||||
(if (> (* i i) n) (return i))))
|
||||
|
||||
(tedious-sqrt 17)
|
||||
(time (tedious-sqrt 100000000000000000))
|
||||
|
||||
;;; &body lambda list keyword
|
||||
(defmacro whille (test &body body)
|
||||
`(do ()
|
||||
((not ,test))
|
||||
,@body))
|
||||
|
||||
(defvar i)
|
||||
(setf i 0)
|
||||
(whille (> 5 i)
|
||||
(format t "~&calculating and mutating i = ~S" i)
|
||||
(incf i))
|
||||
|
||||
;;; well, i had warning, but things actually worked.
|
||||
|
||||
;; some editors treat &body differently
|
||||
;; by specializing formatting / identing
|
||||
;; and also signals to programmers intend, that's it's a lisp expresison
|
||||
|
||||
;;; DESCTRUCTURING inputs to macro
|
||||
(defmacro mix-and-match-1 (pair1 pair2)
|
||||
(let ((x1 (first pair1))
|
||||
(y1 (second pair1))
|
||||
(x2 (first pair2))
|
||||
(y2 (second pair2)))
|
||||
`(list '(,x1 ,y1)
|
||||
'(,x1 ,y2)
|
||||
'(,x2 ,y1)
|
||||
'(,x2 ,y2))))
|
||||
|
||||
(mix-and-match-1 (fred wilma) (tony bony))
|
||||
|
||||
;; but, we coult treat arguments as lists where we define marco
|
||||
(defmacro mix-and-match-2 ((x1 y1) (x2 y2))
|
||||
`(list '(,x1 ,y1)
|
||||
'(,x1 ,y2)
|
||||
'(,x2 ,y1)
|
||||
'(,x2 ,y2)))
|
||||
|
||||
(mix-and-match-2 (fred wilma) (tony bony))
|
||||
|
||||
;; and what would happen if it wasn't exact match with list of 2 elements?
|
||||
|
||||
(mix-and-match-2 (fred wilma caddy) (tony bony))
|
||||
;; it fails with some check error
|
||||
|
||||
;;; example in the book about macro DOVECTOR
|
||||
|
||||
;;; So, what's that about Dynamic scoping & Lexical scoping?
|
||||
|
||||
;; wow, i think I understand
|
||||
|
||||
;; step 1: get two variables, one lexical - fished, one dynamic - birds
|
||||
(setf fishes '(salmon trout))
|
||||
|
||||
(defvar birds)
|
||||
(setf birds '(eagle parrot))
|
||||
|
||||
(defun show-fishes ()
|
||||
fishes)
|
||||
(show-fishes)
|
||||
|
||||
(defun show-birds ()
|
||||
birds)
|
||||
(show-birds)
|
||||
|
||||
(defun see-lexical-scoping (fishes)
|
||||
`(local ,fishes and from #'show-fishes - ,(show-fishes)))
|
||||
|
||||
(see-lexical-soping '(kilka akula))
|
||||
|
||||
(defun see-dynamic-scoping (birds)
|
||||
`(local ,birds and from #'show-birds - ,(show-birds)))
|
||||
|
||||
(see-dynamic-scoping '(sova dyatel))
|
||||
;; when I called #'show-birds from inside #'see-dynamic-scoping
|
||||
;; it didn't go to the top level for value of 'birds
|
||||
;; the value for 'birds was taken from previous "redefinition"
|
||||
;; i.e any time we enter a funtion that defined dynamicly scoped variable
|
||||
;; value of that variable, until we return from the funtion, is taken from it
|
||||
|
||||
#'defvar ; when something could be assigned
|
||||
#'defparameter ; settings, not assigned, to change reeval defparameter
|
||||
#'defconstant ; should never change
|
||||
|
||||
;;; use for special variable
|
||||
*print-base* ; if we override it as parameter for our function
|
||||
; then FORMAT would pick up that value
|
||||
(defun print-in-base (*print-base* x)
|
||||
(format t "~&I'm printing ~D as ~S in base ~D" x x *print-base*))
|
||||
;; if I use ~S to print *print-base*, then 2 in base 2 is 10, 12 in base 12 is 10. lol
|
||||
|
||||
(print-in-base 10 65)
|
||||
(print-in-base 2 65)
|
||||
(print-in-base 3 65)
|
||||
(print-in-base 12 22)
|
||||
|
||||
;; dynamic variable accepts changes from called functions, while scope that
|
||||
;; rebound it is alive can be used to communicate information between parts of
|
||||
;; system. that's quite complicated
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
;;; &optional (with and without default value)
|
||||
;;; &rest
|
||||
;;; &key (with or without default value)
|
||||
;;; &aux - similar to LET* - additional variables, that can be calculated from other inputs, for example &rest
|
||||
;;;
|
||||
;; cool
|
||||
|
||||
;; default argument
|
||||
(defun lala-1 (x &optional y)
|
||||
(format t "~&x value is ~S" x)
|
||||
(format t "~&y value is ~S" y)
|
||||
(list x y))
|
||||
|
||||
(lala-1 2 5)
|
||||
(lala-1 7)
|
||||
|
||||
(defun lala-2 (x &optional (y 2))
|
||||
(format t "~&x value is ~S" x)
|
||||
(format t "~&y value is ~S" y)
|
||||
(list x y))
|
||||
|
||||
(lala-2 1 5)
|
||||
(lala-2 7)
|
||||
|
||||
;; rest arguments - accessed as list, unlimited number on call
|
||||
(defun lala-3 (x y &rest args)
|
||||
(append (list x y) args))
|
||||
|
||||
(lala-3 7 5 1 2 34 5 6)
|
||||
|
||||
;;; keyword arguments
|
||||
(defun make-sundae (name &key (ice-cream `vanilla)
|
||||
(syrup `chocolate)
|
||||
nuts
|
||||
cherries
|
||||
whipped-cream)
|
||||
(list 'sundae
|
||||
(list 'for name)
|
||||
(list ice-cream 'with syrup 'sypup)
|
||||
(list 'toppings '=
|
||||
(remove nil
|
||||
(list (and nuts 'nuts)
|
||||
(and cherries 'cherries)
|
||||
(and whipped-cream 'whipped-cream))))))
|
||||
|
||||
(make-sundae 'yo)
|
||||
(make-sundae 'yo
|
||||
:syrup 'maple
|
||||
:whipped-cream t)
|
||||
|
||||
;;; auxillary variables
|
||||
;; &aux - additional local variables?
|
||||
;; "a matter of taste, whether to use LET* around body or &aux attributes"
|
||||
|
||||
(defun my-average (&rest args
|
||||
&aux (len (length args)))
|
||||
(/ (reduce #'+ args) len))
|
||||
|
||||
(my-average 1 2 3 4 5 6)
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
;; https://www.tutorialspoint.com/lisp/lisp_packages.htm
|
||||
;;
|
||||
;; how do I check in which package I'm by default / right now?
|
||||
;; it's stored in variable
|
||||
;;
|
||||
;; (in-package "COMMON-LISP-USER") => #<PACKAGE "COMMON-LISP-USER">
|
||||
;; (package-name *package*) => "COMMON-LISP-USER"
|
||||
;;
|
||||
;; how did I find it? I called sly-documentation-lookup (C-c C-d C-h)
|
||||
;; and searched for package, and http://www.lispworks.com/documentation/HyperSpec/Body/f_pkg_na.htm
|
||||
;; had examples!
|
||||
|
||||
*package*
|
||||
(package-name *package*)
|
||||
|
||||
;; yay!
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
|
||||
;; that's for initial installation
|
||||
;; (load "~/Downloads/quicklisp.lisp")
|
||||
|
||||
;; that prints into repl -
|
||||
;; (quicklisp-quickstart:help) and (quicklisp-quickstart:install) are paths forward
|
||||
;; would I maybe want to install it with nix?
|
||||
;;
|
||||
;; I could try
|
||||
;; I guess it works, there's binary and /lib in ~/.nix-profille
|
||||
;; /home/efim/.nix-profile/lib/common-lisp/quicklisp/setup.lisp
|
||||
|
||||
;; so, "loading after installation" from https://www.quicklisp.org/beta/#loading
|
||||
;; is what I'd want
|
||||
|
||||
;; (load "~/.nix-profile/lib/common-lisp/quicklisp/setup.lisp")
|
||||
;; error! "Can't create directory", welp
|
||||
;; then how would I load it?
|
||||
;; do I need to modify sbcl startup?
|
||||
;; sbcl is also installed with nix, so it could probably integrate loading of quicklisp?
|
||||
|
||||
;;; welp, I've asked a question on discourse
|
||||
;; maybe somebody will help, and then I'd document this
|
||||
;; https://discourse.nixos.org/t/how-to-use-quicklisp-with-sbcl/20539
|
||||
|
||||
;; I'll proceed with manual installation
|
||||
;; https://www.quicklisp.org/beta/#loading
|
||||
|
||||
;; well, that seems to work. with manual step of adding to ~/.sblcrc
|
||||
;; now restarting sly I have quicklisp
|
||||
;; I guess that's ok
|
||||
|
||||
;;; Now, how to use it?
|
||||
;; one commad is already present in installation guide
|
||||
(ql:system-apropos "vecto")
|
||||
(ql:system-apropos "matrix")
|
||||
(ql:system-apropos "cells")
|
||||
|
||||
;; and there's
|
||||
#'ql:quickload
|
||||
|
||||
;; and counterpart
|
||||
#'ql:uninstall
|
||||
|
||||
;; this is of course absolutely not pure or nixy
|
||||
;; ok, now, I just go about reading on the packages themselves, and there's not much on the quicklisp?
|
||||
;; maybe
|
||||
|
||||
;;; could look into "awesome-cl" list
|
||||
;; maybe I'd find something to play with
|
||||
;; https://github.com/CodyReichert/awesome-cl
|
||||
|
||||
;;; ?? what is "in-package"?
|
||||
(ql:quickload "fset")
|
||||
|
||||
(in-package fset-user)
|
||||
(isetq s (map ('a 2) :default 1))
|
||||
|
||||
|
||||
(in-package cl-user)
|
||||
(isetq s (map ('a 2) :default 1)) ; error, yay
|
||||
|
||||
;; promising things to look at are
|
||||
;; cl21 http://cl21.org/
|
||||
;; Alexandria
|
||||
;; FSet https://fset.common-lisp.dev/Site/FSet-Tutorial.html
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
|
||||
(null 'a)
|
||||
(null ())
|
||||
(null nil)
|
||||
|
||||
(defun anyoddp (x)
|
||||
(cond ((null x) nil)
|
||||
((odd (first x)) t)
|
||||
(t (anyoddp (rest x)))))
|
||||
|
||||
(trace anyoddp)
|
||||
(anyoddp (list 6 1))
|
||||
(untrace)
|
||||
(rest '(5 4 3 2 1))
|
||||
|
||||
;;; my error was - function wasn't named odd, it was oddp
|
||||
;;; and in the debugger it looked like:
|
||||
;;; ("undefined function" 6)
|
||||
;;; and I thought that 6 was treated as undefined function in list (6 1) for some reason
|
||||
|
||||
(defun laugh (n)
|
||||
(defun laugh-inner (n acc)
|
||||
(cond ((eq 0 n) acc)
|
||||
(t (laugh-inner (- n 1) (cons 'HA acc )))))
|
||||
(laugh-inner n ()))
|
||||
|
||||
;; I tried to use append
|
||||
;; but how the hell do I add elements to list?
|
||||
;; do I just fucking manually create cons? ugh
|
||||
(cons 1 '(4 5 6))
|
||||
|
||||
(laugh 4)
|
||||
|
||||
(defun square-list (x)
|
||||
(cond ((null x) ())
|
||||
(t (cons (* (first x) (first x))
|
||||
(square-list (rest x))))))
|
||||
|
||||
(square-list '(1 3 5 6))
|
||||
|
||||
;;; count atoms.
|
||||
;;; recursion on nested lists - think of them as binary trees, with car and cdr, that's it
|
||||
|
||||
(atom 1)
|
||||
|
||||
(defun count-atoms (tree)
|
||||
(cond
|
||||
((null tree) 0) ; without that ends of lists would be counted, but didn't include that due to misunderstanding
|
||||
((atom tree) 1)
|
||||
(t (+ (count-atoms (car tree))
|
||||
(count-atoms (cdr tree))))))
|
||||
|
||||
(count-atoms '(1 (4 5) 2 ))
|
||||
|
||||
(defun pairings (x y)
|
||||
(cond ((or (null x) (null y)) ())
|
||||
(t (cons (list (first x) (first y))
|
||||
(pairings (rest x) (rest y))))))
|
||||
|
||||
(pairings '(1 2 3 7) '(a b c d))
|
||||
|
||||
;;; looking into debugger
|
||||
(defun my-fact (n)
|
||||
(cond ((zerop n) (break "N is zero")
|
||||
;; 1
|
||||
)
|
||||
(t (* n (my-fact (- n 1))))))
|
||||
|
||||
(my-fact 4)
|
||||
|
||||
;;; So - debugger keys and functions
|
||||
;; C-j and C-k are for moving between frames
|
||||
;; for frame context commands R - return from frame with particular value (sly-db-return-from-frame)
|
||||
;; x - step over, s - step
|
||||
;; e - eval in frame, i - inspect in frame (show additional info on evaluated value)
|
||||
;; RET - toggle details for current frame
|
||||
;; v - show frames code
|
||||
;; d - pretty-print-eval-in-frame
|
||||
;; (searching all of functions by going into debugger bugger and looking at *helpful* (C-h C-f) "sly-db-"
|
||||
|
||||
;; could also try to recompile thing, maybe r for restart, or R to return with value 1 from last frame and check how it all works
|
||||
|
||||
;;; better way to define inner functions : LABELS
|
||||
;;; similar to LET form, binding names to arglists and body
|
||||
;;; they are "local functions"
|
||||
;;; can call each other, and reference parent variables
|
||||
|
||||
(defun factor-tree (n)
|
||||
(factors-help n 2))
|
||||
|
||||
(defun factors-help (n p)
|
||||
(cond
|
||||
((equal p n) n)
|
||||
((zerop (rem n p)) (list n p (factors-help (/ n p) p)))
|
||||
(t (factors-help n (+ 1 p)))))
|
||||
|
||||
(factor-tree 60)
|
||||
|
||||
(trace factors-help)
|
||||
(untrace) ; and there's no need to try to do println, and less errors in that
|
||||
|
|
@ -0,0 +1,116 @@
|
|||
|
||||
;; chapter 12, not covering CLOS
|
||||
|
||||
(defstruct starship
|
||||
(name nil)
|
||||
(speed 0)
|
||||
(condition `green)
|
||||
(shields `down))
|
||||
|
||||
;; this defines also a MAKE-STARSHIP
|
||||
;; and also STARSHIP becomes type that works with TYPEP and TYPE-OF, and type predicate STARSHIP-P
|
||||
|
||||
(setf s1 (make-starship))
|
||||
s1
|
||||
|
||||
(setf s2 '#s(starship speed (warp 3)
|
||||
condition red
|
||||
shields up))
|
||||
s2
|
||||
|
||||
(type-of s2)
|
||||
|
||||
;; also there are accessor functions:
|
||||
(starship-shields s2)
|
||||
(starship-speed s2)
|
||||
|
||||
;; and they can be used for SETF as place functions, cool
|
||||
(setf (starship-name s1) "Enterprise")
|
||||
s1
|
||||
|
||||
;;; and the constructor also takes arguments as &keys
|
||||
(setf s3 (make-starship :name "Reliant"
|
||||
:shields 'damaged))
|
||||
|
||||
(describe s3)
|
||||
|
||||
;;; exercise, discrimination net
|
||||
(defstruct node
|
||||
name
|
||||
question
|
||||
yes-case
|
||||
no-case)
|
||||
|
||||
(setf *NODE-LIST* nil)
|
||||
|
||||
(defun init ()
|
||||
(setf *node-list* nil))
|
||||
(init)
|
||||
|
||||
(defun add-node (name question yes-case no-case)
|
||||
(push (make-node :name name
|
||||
:question question
|
||||
:yes-case yes-case
|
||||
:no-case no-case)
|
||||
*node-list*))
|
||||
|
||||
|
||||
(add-node 'other
|
||||
"Bad question?"
|
||||
"Hello, yesman"
|
||||
"Goodbye, noman")
|
||||
|
||||
(add-node 'start
|
||||
"Does the engine turn over?"
|
||||
'engine-turns-over
|
||||
'engine-wont-turn-over)
|
||||
|
||||
(add-node 'engine-turns-over
|
||||
"lalal?"
|
||||
"yes, lala"
|
||||
"no, alallala")
|
||||
|
||||
*node-list*
|
||||
|
||||
(defun find-node (name nodes)
|
||||
(find name nodes :test (lambda (left right) (equal (node-name right) left))))
|
||||
;; so in :test function, first item is the one we're searching for
|
||||
;; and right one is the one we iterate over
|
||||
|
||||
(find-node 'start *node-list*)
|
||||
(find-node 'other *node-list*)
|
||||
(find-node 'engine-turns-over *node-list*)
|
||||
|
||||
;; either print that node not defined
|
||||
;; or ask question and return action
|
||||
(defun process-node (name)
|
||||
(let ((current-node (find-node name *node-list*)))
|
||||
(if current-node
|
||||
(progn
|
||||
(format t "~&~S" (node-question current-node))
|
||||
(if (yes-or-no-p) (node-yes-case current-node)
|
||||
(node-no-case current-node)))
|
||||
(format t "~&No node is defined"))))
|
||||
|
||||
(process-node 'start)
|
||||
(process-node 'engine-turns-over)
|
||||
(process-node 'end)
|
||||
|
||||
|
||||
;; on 'start' node
|
||||
;; loop asking question, and processing response
|
||||
;; if node - find and continue running
|
||||
;; if string - print
|
||||
(defun run (node-list)
|
||||
(do ((current-block 'start (process-node current-block)))
|
||||
(nil)
|
||||
( if (stringp current-block)
|
||||
(format t "~S" current-block))
|
||||
(if (or (stringp current-block)
|
||||
(null current-block))
|
||||
(return))))
|
||||
|
||||
(process-node 'start)
|
||||
(process-node 'engine-turns-over)
|
||||
|
||||
(run *node-list*)
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
"The North Slope"
|
||||
((45 redwood) (12 oak) (43 maple))
|
||||
100
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
|
||||
|
||||
;;; TIME
|
||||
;; it's profiling of evaluation
|
||||
(defun addup (n)
|
||||
(do ((i 0 (+ 1 i))
|
||||
(sum 0 (+ sum i)))
|
||||
((> i n) sum)))
|
||||
|
||||
(time (addup 10)) ; prints into repl
|
||||
(time (addup 1000000))
|
||||
(time (addup 10000000))
|
||||
|
||||
|
||||
;;; DESCRIBE and INSPECT
|
||||
(describe #'cons) ; prints into repl, same as K +lookup/documentation
|
||||
|
||||
;; INSPECT - is interactive
|
||||
;; H - for help
|
||||
;; U - for UP, Q/E - to exit
|
||||
;; numbers - to dig into slots of a structure
|
||||
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
|
||||
(defun half (n) (* n 0.5))
|
||||
|
||||
(defun average (x y)
|
||||
(half (+ x y)))
|
||||
|
||||
(trace) ; returns list of traced functions
|
||||
(trace half average)
|
||||
|
||||
(average 7 5) ; tree of calls printed into repl
|
||||
|
||||
(untrace half)
|
||||
(untrace) ; untraces all
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
;; setq defvar defun - examples of sideffectful things
|
||||
|
||||
(random 100)
|
||||
|
||||
;; setq could even change local variables (defined by function arguments)
|
||||
(defun bad-style (p)
|
||||
"This function will overdefine it's input P."
|
||||
(setf p (+ p 2)) ; changes local variable
|
||||
(setf r (* p 2))
|
||||
`(result is ,p))
|
||||
|
||||
p ; this is not set by the setf
|
||||
r ; this global value is changed
|
||||
|
||||
(bad-style 15)
|
||||
|
||||
;; wait, there's setf, what's different in setq?
|
||||
;; setf has "place" as first item, so setter forms
|
||||
|
||||
(documentation `setf `function)
|
||||
(documentation `setq `function)
|
||||
|
||||
(apropos "random")
|
||||
|
||||
;;; exercises
|
||||
|
||||
(defun throw-die ()
|
||||
(+ 1 (random 6)))
|
||||
(throw-die)
|
||||
|
||||
(defun throw-dice ()
|
||||
(list (throw-die) (throw-die)))
|
||||
(throw-dice)
|
||||
|
||||
(defun snake-eyes-p (thro)
|
||||
(equal thro `(1 1)))
|
||||
(snake-eyes-p `(1 1))
|
||||
(snake-eyes-p `(1 2))
|
||||
|
||||
(defun boxcars-p (thro)
|
||||
(equal thro `(6 6)))
|
||||
(boxcars-p `(6 6))
|
||||
(boxcars-p `(1 2))
|
||||
|
||||
(funcall `+ `(1 2)) ; 149
|
||||
(apply `+ `(1 2 5))
|
||||
|
||||
(defun instant-win-p (the-throw)
|
||||
(let ((win-hands `(7 11))
|
||||
(sum (apply #'+ the-throw)))
|
||||
(member sum win-hands)))
|
||||
|
||||
(defun instant-loss-p (the-throw)
|
||||
(let ((loose-hands `(2 3 12))
|
||||
(sum (apply #'+ the-throw)))
|
||||
(member sum loose-hands)))
|
||||
;;; breaking my head, looking for #'contains function for list
|
||||
;;; apropos doesn't quite help
|
||||
(member 7 (list 1 4 7 11)) ; well, member returns "rest"
|
||||
|
||||
(instant-win-p `(6 5)) ; so, this is correct. cool
|
||||
(or `t nil)
|
||||
|
||||
(instant-loss-p `(6 5))
|
||||
|
||||
(defun say-throw (the-throw)
|
||||
(cond ((equal the-throw `(1 1)) `snake-eyes)
|
||||
((equal the-throw `(6 6)) `boxcars)
|
||||
(t (apply #'+ the-throw))))
|
||||
(say-throw '(1 1))
|
||||
(say-throw '(6 6))
|
||||
(say-throw '(2 5))
|
||||
|
||||
;; firsth throw either insta-win, insta-loose, or set point
|
||||
(defun craps ()
|
||||
(let* ((the-throw (throw-dice ))
|
||||
(result (cond ((instant-loss-p the-throw) `(,(say-throw the-throw) -- you loose))
|
||||
((instant-win-p the-throw) `(,(say-throw the-throw) -- you win))
|
||||
(t `(your point is ,(say-throw the-throw))))))
|
||||
(append `(throw ,(first the-throw) and ,(second the-throw) -- ) result)))
|
||||
|
||||
(craps)
|
||||
|
||||
(defun try-for-point (point)
|
||||
(let* ((the-throw (throw-dice))
|
||||
(value (apply #'+ the-throw))
|
||||
(result (cond ((equal value point) `(you win))
|
||||
((equal value 7) `(you loose))
|
||||
(t `(throw again)))))
|
||||
(append `(throw ,(first the-throw) and ,(second the-throw) -- ,value --) result)))
|
||||
|
||||
(try-for-point 8)
|
||||
|
||||
;; next onto the 6, list data structures
|
||||
Loading…
Reference in New Issue