More progress. Got up to 2.65
This commit is contained in:
Emin Arslan
parent
93fe63d683
commit
ce27776d82
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,2 +1,3 @@
|
||||
\#*
|
||||
*~
|
||||
*.fasl
|
||||
|
||||
54
ex-2-40.rkt
54
ex-2-40.rkt
@ -133,6 +133,7 @@
|
||||
(make-vect (* (vect-xcoor v) n)
|
||||
(* (vect-ycoor v) n)))
|
||||
;; 2.47
|
||||
;; a list-of-three representation
|
||||
(define (make-frame1 origin edge1 edge2)
|
||||
(list origin edge1 edge2))
|
||||
(define (frame-origin1 f)
|
||||
@ -142,8 +143,61 @@
|
||||
(define (frame-edge2-1 f)
|
||||
(list-ref f 2))
|
||||
|
||||
; two cons representation
|
||||
(define (make-frame2 origin edge1 edge2)
|
||||
(cons origin (cons edge1 edge2)))
|
||||
(define frame-origin2 car)
|
||||
(define frame-edge1-2 cadr)
|
||||
(define frame-edge2-2 cddr)
|
||||
|
||||
; choose one impl
|
||||
(define origin-frame frame-origin2)
|
||||
(define edge1-frame frame-edge1-2)
|
||||
(define edge2-frame frame-edge2-2)
|
||||
|
||||
;; 2.48
|
||||
;; decided to stop using define-struct for this, as it kinda
|
||||
;; screws with the naming conventions
|
||||
(define make-segment cons)
|
||||
|
||||
(define start-segment car)
|
||||
(define end-segment cdr)
|
||||
|
||||
;; 2.49
|
||||
(define (draw-line x y) #f)
|
||||
(define (frame-coord-map frame)
|
||||
(lambda (v)
|
||||
(add-vect
|
||||
(origin-frame frame)
|
||||
(add-vect (scale-vect (xcoor-vect v) (edge1-frame frame))
|
||||
(scale-vect (ycoor-vect v) (edge2-frame frame))))))
|
||||
(define (segments->painter segment-list)
|
||||
(lambda (frame)
|
||||
(for-each
|
||||
(lambda (segment)
|
||||
(draw-line
|
||||
((frame-coord-map frame)
|
||||
(start-segment segment))
|
||||
((frame-coord-map frame)
|
||||
(end-segment segment))))
|
||||
segment-list)))
|
||||
|
||||
; I really should have thought of making a better
|
||||
; notation for these things, it would have been super easy too.
|
||||
; but I've already written it, so it stays, I guess.
|
||||
(define outline-painter
|
||||
(segments->painter
|
||||
(list (make-segment (make-vect 0 0) (make-vect 0 1))
|
||||
(make-segment (make-vect 0 0) (make-vect 1 0))
|
||||
(make-segment (make-vect 1 0) (make-vect 1 1))
|
||||
(make-segment (make-vect 0 1) (make-vect 1 1)))))
|
||||
(define x-painter
|
||||
(segments->painter
|
||||
(list (make-segment (make-vect 0 0) (make-vect 1 1))
|
||||
(make-segment (make-vect 1 0) (make-vect 0 1)))))
|
||||
(define diamond
|
||||
(segments->painter
|
||||
(list (make-segment (make-vect 0.5 0) (make-vect 0 0.5))
|
||||
(make-segment (make-vect 0.5 0) (make-vect 1 0.5))
|
||||
(make-segment (make-vect 0 0.5) (make-vect 0.5 1))
|
||||
(make-segment (make-vect 1 0.5) (make-vect 0.5 1)))))
|
||||
|
||||
212
ex-2-53.lisp
Normal file
212
ex-2-53.lisp
Normal file
@ -0,0 +1,212 @@
|
||||
;; I'm using common lisp from this point on,
|
||||
;; I honestly kind of got bored with scheme.
|
||||
;; CL is pretty good though. using scheme now.
|
||||
|
||||
;; well, this means we gotta reimplement
|
||||
;; a lot of the things in the book, because we can't
|
||||
;; just copy&paste them. but that's fine.
|
||||
|
||||
;; as an aside, I probably could get pretty close
|
||||
;; to being able to copy-paste with this macro:
|
||||
(defun rest-symbol (param-list)
|
||||
(cond
|
||||
((null param-list)
|
||||
nil)
|
||||
((consp param-list)
|
||||
(cons (car param-list) (rest-symbol (cdr param-list))))
|
||||
((symbolp param-list)
|
||||
(list '&rest param-list))
|
||||
(t (error "non-symbol as tail element of parameter list."))))
|
||||
(defmacro define (name &body body)
|
||||
(cond
|
||||
((symbolp name) `(defparameter ,name ,@body))
|
||||
((listp name) `(defun ,(first name)
|
||||
,(rest-symbol (rest name))
|
||||
,@body))
|
||||
(t (error "Whoops, cannot expand define"))))
|
||||
;; This essentially allows us to use scheme-style
|
||||
;; define syntax for defining variables and
|
||||
;; procedures.
|
||||
;; I won't be using this for every single exercise though,
|
||||
;; cuz that's kinda boring.
|
||||
|
||||
|
||||
(defun memq (item l)
|
||||
"This definition doesn't have many differences from the book."
|
||||
(cond
|
||||
((null l) nil)
|
||||
((eq item (car l)) l)
|
||||
(t (memq item (cdr l)))))
|
||||
|
||||
(memq 'apple '(pear banana prune)) ;; => NIL
|
||||
(memq 'apple '(x (apple sauce) y apple pear)) ;; = (APPLE PEAR)
|
||||
|
||||
;; EX 2.54
|
||||
(defun my-equal? (a b)
|
||||
"fun fact: when I first began common lisp, I used to be kind of annoyed/afraid
|
||||
of defining functions recursively like this. I thought this would be less efficient
|
||||
than using a loop like in C.
|
||||
|
||||
Now I know better of course. On SBCL, this is fully tail call optimised,
|
||||
and therefore can be used on lists of any length with no fear for
|
||||
stack overflow. It generates an iterative process, despite being \"recursive\"
|
||||
so this is actually as efficient as can be."
|
||||
(cond
|
||||
((eq a b) t)
|
||||
((and (listp a) (listp b))
|
||||
(if (my-equal? (car a) (car b))
|
||||
(my-equal? (cdr a) (cdr b))
|
||||
nil))
|
||||
(t nil)))
|
||||
|
||||
|
||||
;; Wooooo! symbolic derivation.
|
||||
;; ex 2.56 is inside here somewhere
|
||||
|
||||
(defun var= (v1 v2)
|
||||
(and (symbolp v1) (symbolp v2) (eq v1 v2)))
|
||||
|
||||
(defun var!= (v1 v2)
|
||||
(and (symbolp v1) (symbolp v2) (not (eq v1 v2))))
|
||||
|
||||
(defun sump (e)
|
||||
(and (listp e) (eq '+ (car e))))
|
||||
|
||||
(defun addend (e)
|
||||
(second e))
|
||||
(defun augend (e)
|
||||
;; 2.57
|
||||
(if (> (length e) 3)
|
||||
`(+ ,@(cddr e))
|
||||
(third e)))
|
||||
|
||||
(defun productp (e)
|
||||
(and (listp e) (eq '* (car e))))
|
||||
(defun multiplier (e)
|
||||
(second e))
|
||||
(defun multiplicand (e)
|
||||
;; 2.57
|
||||
(if (> (length e) 3)
|
||||
`(* ,@(cddr e))
|
||||
(third e)))
|
||||
|
||||
(defun number= (a b)
|
||||
(and (numberp a) (numberp b) (= a b)))
|
||||
|
||||
(defun make-sum (a b)
|
||||
(cond
|
||||
((and (numberp a) (numberp b)) (+ a b))
|
||||
((number= a 0) b)
|
||||
((number= b 0) a)
|
||||
(t `(+ ,a ,b))))
|
||||
|
||||
(defun make-product (a b)
|
||||
(cond
|
||||
((and (numberp a) (numberp b)) (* a b))
|
||||
((number= a 0) 0)
|
||||
((number= a 1) b)
|
||||
((number= b 0) 0)
|
||||
((number= b 1) a)
|
||||
(t (append (list '*)
|
||||
(if (productp a) (cdr a) (list a))
|
||||
(if (productp b) (cdr b) (list b))))))
|
||||
|
||||
(defun expt-p (e)
|
||||
(and (listp e) (eq '** (car e))))
|
||||
(defun base (e)
|
||||
(second e))
|
||||
(defun exponent (e)
|
||||
(third e))
|
||||
|
||||
(defun make-expt (b e)
|
||||
(cond
|
||||
((number= b 0) 0)
|
||||
((number= b 1) 1)
|
||||
((number= e 0) 1)
|
||||
((number= e 1) b)
|
||||
(t `(** ,b ,e))))
|
||||
|
||||
(defun deriv (expr var)
|
||||
(cond
|
||||
((numberp expr) 0) ;; c/dx = 0
|
||||
((var= expr var) 1) ;; dx/dx = 1
|
||||
((and (symbolp expr) (var!= expr var)) 0)
|
||||
((sump expr)
|
||||
(make-sum (deriv (addend expr) var)
|
||||
(deriv (augend expr) var)))
|
||||
((productp expr)
|
||||
(make-sum (make-product (multiplier expr) (deriv (multiplicand expr) var))
|
||||
(make-product (multiplicand expr) (deriv (multiplier expr) var))))
|
||||
;; EX 2.56 - exponentiaton derived.
|
||||
((expt-p expr)
|
||||
(make-product (exponent expr)
|
||||
(make-product (make-expt (base expr) (make-sum -1 (exponent expr)))
|
||||
(deriv (base expr) var))))
|
||||
(t (error "unknown"))))
|
||||
|
||||
;; 2.58 - okay, so we *could* modify the selectors and stuff
|
||||
;; above to make this work, but I kinda wanna keep those.
|
||||
;; instead, I'll just make a function that transforms the new
|
||||
;; input into the old input format (this is trivial for the
|
||||
;; case with fully parenthesized input)
|
||||
(defun transform-input (expr)
|
||||
(if (listp expr)
|
||||
(list (second expr) (transform-input (first expr)) (transform-input (third expr)))
|
||||
expr))
|
||||
(defun deriv-infix (e v)
|
||||
(deriv (transform-input e) v))
|
||||
|
||||
;; ... and also kind of doable for the more general case.
|
||||
;; requires more work though, but I guess that's the point.
|
||||
(defparameter op-precedence (make-hash-table))
|
||||
(loop for i in '((+ 1) (* 3) (** 5))
|
||||
do (setf (gethash (car i) op-precedence) (second i)))
|
||||
|
||||
(defun prec (op)
|
||||
(gethash op op-precedence))
|
||||
(defun collapse (ops items)
|
||||
(if (null ops)
|
||||
(car items)
|
||||
(collapse (cdr ops)
|
||||
(cons (list (first ops) (second items) (first items))
|
||||
(cddr items)))))
|
||||
|
||||
;; (3 + 5 * 6 + 2)
|
||||
;; (helper 0 expr nil)
|
||||
;; (helper 1 '(5 * 6 + 2) '(+) '(3))
|
||||
;; (helper 3 '(6 + 2) '(* +) '(5 3))
|
||||
;; (helper 1 '(2) '() '(+ (* 6 5) 3))
|
||||
;; (+ 3 (* 5 6) 2)
|
||||
;; Fuckkkkkkk
|
||||
;; this took way longer than it needed to.
|
||||
;; not a good-looking implementation at all, really ugly.
|
||||
;; but it works! correctly transforms infix notation
|
||||
;; to prefix. (output can be directly used by deriv)
|
||||
(defun transform-infix (expr)
|
||||
(cond
|
||||
((null expr) nil)
|
||||
((or (numberp expr) (symbolp expr)) expr)
|
||||
(t (labels ((helper (expr ops items)
|
||||
(format t "~a ~a ~a~%" expr ops items)
|
||||
(cond
|
||||
((null expr) items)
|
||||
((null (cdr expr))
|
||||
(collapse ops (cons (transform-infix
|
||||
(car expr))
|
||||
items)))
|
||||
((>= (prec (second expr)) (or (prec (car ops)) 0))
|
||||
(helper (cddr expr)
|
||||
(cons (second expr) ops)
|
||||
(cons (transform-infix (first expr))
|
||||
items)))
|
||||
(t
|
||||
(helper (cddr expr)
|
||||
(cons (second expr) nil)
|
||||
(list (collapse ops
|
||||
(cons (transform-infix
|
||||
(first expr))
|
||||
items))))))))
|
||||
(helper expr '() '())))))
|
||||
|
||||
(defun deriv-real-infix (e v)
|
||||
(deriv (transform-infix e) v))
|
||||
112
ex-2-59.lisp
Normal file
112
ex-2-59.lisp
Normal file
@ -0,0 +1,112 @@
|
||||
|
||||
;; not gonna bother copy-pasting the rest of the implementation.
|
||||
;; ex 2.59
|
||||
(defun adjoin-set (s i)
|
||||
(if (element-of-set? s i)
|
||||
s
|
||||
(cons i s)))
|
||||
(defun union-set (s1 s2)
|
||||
(labels ((rec (s1 s2)
|
||||
(if (null s1)
|
||||
s2
|
||||
(rec (cdr s1) (adjoin-set s2 (car s1))))))
|
||||
(rec s1 s2)))
|
||||
|
||||
;; ex 2.60
|
||||
;; element-of-set? doesn't change I'm pretty sure.
|
||||
(defun element-of-set? (s e)
|
||||
(if (null s)
|
||||
nil
|
||||
(element-of-set? (cdr s) e)))
|
||||
;; adjoin becomes more efficient, as it is now an O(1) operation
|
||||
(defun adjoin-set-duppy (s e)
|
||||
(cons e s))
|
||||
;; union-set becomes a linear-time algorithm as it relies on adjoin-set.
|
||||
;; doesn't really change in logic otherwise, though.x
|
||||
(defun union-set-duppy (s1 s2)
|
||||
(labels ((rec (s1 s2)
|
||||
(if (null s1)
|
||||
s2
|
||||
(rec (cdr s1) (adjoin-set s2 (car s1))))))
|
||||
(rec s1 s2)))
|
||||
|
||||
;; ex 2.61
|
||||
;; Note: NOT tail recursive. not gonna work for too long lists.
|
||||
;; though the book's given intersection-list is also not tail
|
||||
;; recursive, so this is probably intended.
|
||||
(defun adjoin-set-ordered (s1 i)
|
||||
(cond
|
||||
((null s1) (cons i nil))
|
||||
((= i (car s1)) s1)
|
||||
((< i (car s1))
|
||||
(cons i s1))
|
||||
(t (cons (car s1) (adjoin-set-ordered (cdr s1) i)))))
|
||||
|
||||
;; ex 2.62
|
||||
;; same with 2.61, not tail recursive
|
||||
;; both could be translated fairly easily though
|
||||
(defun union-set-ordered (s1 s2)
|
||||
(cond
|
||||
((null s1) s2)
|
||||
((null s2) s1)
|
||||
((= (car s1) (car s2))
|
||||
(cons (car s1)
|
||||
(union-set-ordered (cdr s1) (cdr s2))))
|
||||
((> (car s1) (car s2))
|
||||
(cons (car s2)
|
||||
(union-set-ordered s1 (cdr s2))))
|
||||
((< (car s1) (car s2))
|
||||
(cons (car s1)
|
||||
(union-set-ordered (cdr s1) s2)))
|
||||
(t (error "asd"))))
|
||||
|
||||
;; ex 2.63
|
||||
;; a) it looks like the result should be the same.
|
||||
;; tried the code, couldn't get them to give different results.
|
||||
;; on the figure 2.16 trees, they all give the same results.
|
||||
;; b) At first glance they might look equivalent. However,
|
||||
;; the first algorithm has a hidden cost in the append operation.
|
||||
;; because the fastest way to append two linked lists is an O(N)
|
||||
;; operation: so eventually it becomes O(N/2 + 2N/4 + 4N/8 + ... + logN)
|
||||
;; or something like that, which is O(N + logn) or O(N).
|
||||
;; the second algorithm doesn't waste time with that, and is therefore
|
||||
;; a flat O(logN). The second one takes less time.
|
||||
|
||||
;; damn, raw lisp code can be hard to read. might be a skill issue.
|
||||
;; ex 2.64
|
||||
;; "short" paragraph. yeah.
|
||||
;; Okay, so...
|
||||
;; partial-tree takes a list of elements and n.
|
||||
;; in the base case, i.e. n = 0, the result is trivially just (cons nil elts)
|
||||
;; otherwise, the function calculates the length of the left half of the tree,
|
||||
;; recursively calls itself with that "left half". As partial-tree returns
|
||||
;; the rest of the elements, we take the "right half" from this rest of the elements
|
||||
;; (of course making sure to save and exclude the center element, as that is
|
||||
;; the root of the tree).
|
||||
;; This way, we create a tree by recursively creating the left subtree, then the right
|
||||
;; subtree, then we simply combine these to create the final tree.
|
||||
;; b) O(N) each element is visited exactly once.
|
||||
|
||||
;; ex 2.65
|
||||
;; assuming the union and intersection don't have to maintain
|
||||
;; balance (or that's handled by something else)
|
||||
(defstruct btree elt left right)
|
||||
(defun adjoin-set-tree (s i)
|
||||
(cond
|
||||
((null s) (make-btree :elt i :left nil :right nil))
|
||||
((= (btree-elt s) i) s)
|
||||
((< (btree-elt s) i)
|
||||
(make-btree :elt (btree-elt s)
|
||||
:left (btree-left s)
|
||||
:right (adjoin-set-tree (btree-right s) i)))
|
||||
((> (btree-elt s) i)
|
||||
(make-btree :elt (btree-elt s)
|
||||
:left (adjoin-set-tree (btree-left s) i)
|
||||
:right (btree-right s)))))
|
||||
(defun union-set-tree (s1 s2)
|
||||
(cond
|
||||
((null s1) s2)
|
||||
((null s2) s1)
|
||||
(t (union-set-tree (union-set-tree (btree-left s1) (btree-right s2))
|
||||
(adjoin-set-tree s2 (btree-elt s1))))))
|
||||
;; yeah, okay. this looks good enough, didn't test it at all, but whatevs.
|
||||
Loading…
x
Reference in New Issue
Block a user