efim
/
common-lisp-study
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exercises and notes from "Gentle introduction"

This commit is contained in:
efim 2022-07-24 11:52:07 +00:00
commit 067aebaf81
21 changed files with 1597 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
FSMs.lisp Normal file
View File

@ -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

99
applicative-style.lisp Normal file
View File

@ -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))

80
arrays.lisp Normal file
View File

@ -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!

48
assignment.lisp Normal file
View File

@ -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

365
basics.lisp Normal file
View File

@ -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)

23
break-and-error.lisp Normal file
View File

@ -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

4
hello.lisp Normal file
View File

@ -0,0 +1,4 @@
(defun hello ()
(write-line "What is your name?")
(let ((name (read-line)))
(format t "Hello, ~A.~%" name)))

117
input-output.lisp Normal file
View File

@ -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")

98
iteration-and-block-structure.lisp Normal file
View File

@ -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

61
list-structure.lisp Normal file
View File

@ -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"

200
macro-and-compilartion.lisp Normal file
View File

@ -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

59
optional-arguments.lisp Normal file
View File

@ -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)

16
packages.lisp Normal file
View File

@ -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!

66
quicklisp-thing.lisp Normal file
View File

@ -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

100
recursion.lisp Normal file
View File

@ -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
session1.log Normal file
View File

116
structures-and-type-system.lisp Normal file
View File

@ -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*)

3
test-input.lisp Normal file
View File

@ -0,0 +1,3 @@
"The North Slope"
((45 redwood) (12 oak) (43 maple))
100

22
toolkit.lisp Normal file
View File

@ -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

13
trace-and-dtrace.lisp Normal file
View File

@ -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

94
vars-and-effects.lisp Normal file
View File

@ -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