Add exercises for pp lecture 2 and 3

2 files changed, 224 insertions, 0 deletions

diff --git a/sem7/pp/lec2.scm b/sem7/pp/lec2.scm
new file mode 100644
index 0000000..72d6904
--- /dev/null
+++ b/sem7/pp/lec2.scm
@@ -0,0 +1,99 @@
+;; This is not meant do be, please do not use define-syntax too much.
+;; Just leaving this here to remember how it works.
+(define-syntax lambda-curry
+  (syntax-rules ()
+    [(_ (x) b1 b2 ...)
+     (lambda (x) b1 b2 ...)]
+    [(_ (x r ...) b1 b2 ...)
+     (lambda (x)
+       (lambda-curry (r ...) b1 b2 ...)
+       )]
+    ))
+
+(define-syntax call-curry
+  (syntax-rules ()
+    [(_ f x)
+     (f x)]
+    [(_ f x r ...)
+     (call-curry (f x) r ...)]
+    ))
+
+;;# Exercise 2.21
+;;? Create a differentiation function
+;;? For the delta use a very small number ;-)
+(define (diff f)
+  (lambda (x)
+    (let [(delta 0.00001)]
+      (/ (- (f (+ delta x)) (f x)) delta))
+    ))
+
+;; Lets get a text function
+(define (f x) (* x x))
+(define (fd x) (* 2 x))
+
+;;? Create compare-2-function which takes two functions and and array of numbers
+(define (compare-2-funcs f1 f2 numbers)
+  (map (lambda (num)
+	 (- (f2 num) (f1 num)))
+       numbers))
+
+;; Yeah not tail recursive, but its fine
+(define (linspace start stop step)
+  (if (> start stop)
+      '()
+      (cons start (linspace (+ start step) stop step))
+      ))
+
+(define (accumulate f nul)
+  (letrec [(self (lambda (lst)
+		   (if (null? lst)
+		       nul
+		       (f (car lst) (self (cdr lst)))
+		       ))
+		 )] self))
+
+(define sum (accumulate + 0))
+
+;;# Exercise 2.11
+;;? Create a generator function for (cmp x y) which takes a lt (less than) function.
+;;? (cmp x y) returns -1 if x < y, 0 when x = y and 1 when x > y.
+(define (make-cmp lt)
+  (lambda (x y)
+    (cond [(lt x y) -1]
+	  [(lt y x) 1]
+	  [else 0])
+    ))
+
+(define (from-cmp cmp)
+  (let* ([lt (lambda (x y) (= -1 (cmp x y)))]
+	 [gt (lambda (x y) (= 1 (cmp x y)))]
+	 [eq (lambda (x y) (= 0 (cmp x y)))]
+	 ) (values lt gt eq)))
+
+;;# Exercise 2.2
+(define (replication-to list len)
+  (letrec ([recur (lambda (part len res)
+		    (cond [(zero? len) res]
+			  [(null? part) (recur list len res)]
+			  [else (recur (cdr part) (1- len) (cons (car part) res))]
+			  ))]
+	   ) (reverse (recur list len '()))))
+
+;;# Exercise 2.16
+(define (for-all-1 lst p)
+  ((accumulate (lambda (x y) (and y (p x))) #t) lst))
+
+(define (there-exists lst p)
+  ((accumulate (lambda (x y) (or y (p x))) #f) lst))
+
+;; Wow im a bit stupid, but this is much easier with a filter function
+;; The above one's too
+;; I dont want to implement it right now
+(define (there-exists-1 lst p)
+  (car ((accumulate (lambda (x state) (let ([good (p x)])
+					(cons (cond [(not (cdr state)) good]
+						    [good #f]
+						    [else #t])
+					      (or good (cdr state))
+					      ))) (cons #f #f)) lst)))
+
diff --git a/sem7/pp/lec3.scm b/sem7/pp/lec3.scm
new file mode 100644
index 0000000..7babbb8
--- /dev/null
+++ b/sem7/pp/lec3.scm
@@ -0,0 +1,125 @@
+(define (to-string thing)
+  (let ([format-pair-tail
+	 (lambda (tail)
+	   (apply string-append (cond [(null? tail) (list "")]
+				      [(pair? tail) (list " " (to-string tail))]
+				      [else (list " . " (to-string tail))])))
+	 ])
+    (cond [(number? thing) (number->string thing)]
+	  [(symbol? thing) (symbol->string thing)]
+	  [(null? thing) "()"]
+	  [(procedure? thing) "#function#"]
+	  [(pair? thing) (string-append
+			  (to-string (car thing))
+			  (format-pair-tail (cdr thing)))]
+	  [(string? thing) thing]
+	  [else "?"]
+	  )))
+
+(define (create-dispatch methods super-func)
+  (lambda (msg)
+    (let ([method (assoc msg methods)])
+      (if method (cdr method) ((super-func) msg))
+      )))
+
+(define (send obj msg . para)
+  (let ((method (obj msg)))
+    (apply method para)))
+
+(define (new-instance class . para)
+  (apply class (cons '() para)))
+
+;; TODO implement str 
+(define (object self-into)
+  (letrec ([whoami 'object]
+	   [dispatch (create-dispatch (list
+				       [cons 'pretty-str (lambda ()
+							   (to-string (send (self) 'pretty)))]
+				       [cons 'pretty (lambda () (list whoami))]
+				       [cons 'type-of (lambda () whoami)]
+				       [cons 'class-of (lambda () object)]
+				       ) '())]
+	   [self (lambda () (if (null? self-into) dispatch self-into))]
+	   ) dispatch))
+
+(define (point self-into x y)
+  (letrec ([whoami 'point]
+	   [super (lambda () (object (self)))]
+	   [self (lambda () (if (null? self-into) (dispatch) self-into))]
+	   [pretty (lambda () (list whoami x y))]
+	   [move (lambda (dx dy)
+		   (send (self) 'add (new-instance point dx dy)))]
+	   [add (lambda (other)
+		  (new-instance (send (self) 'class-of) (+ x (send other 'getx))
+		    (+ y (send other 'gety))
+		    ))]
+	   [with-color (lambda (color) (new-instance color-point
+						(send (self) 'getx)
+						(send (self) 'gety)
+						color))]
+	   [dispatch (lambda () (create-dispatch (list
+						  [cons 'getx (lambda () x)]
+						  [cons 'gety (lambda () y)]
+						  [cons 'add add]
+						  [cons 'pretty pretty]
+						  [cons 'move move]
+						  [cons 'type-of (lambda () whoami)]
+						  [cons 'class-of (lambda () point)]
+						  [cons 'with-color with-color]
+						  ) super))]
+	   ) (dispatch)))
+
+(define p1 (new-instance point 10 20))
+(define p2 (new-instance point 1 1))
+
+(define (color-point self-into x y . color)
+  (let ((color (if (null? color) 'green (car color))))
+    (letrec ([whoami 'color-point]
+	     [super (lambda () (point (self) x y))]
+	     [self (lambda () (if (null? self-into) (dispatch) self-into))]
+	     [pretty (lambda () (list whoami
+				      (send (self) 'getx)
+				      (send (self) 'gety)
+				      color))]
+	     [dispatch (lambda () (create-dispatch (list
+						    [cons 'get-color (lambda () color)]
+						    [cons 'type-of (lambda () whoami)]
+						    [cons 'pretty pretty]
+						    [cons 'class-of (lambda () color-point)]
+						    ) super))]
+	     ) (dispatch))))
+
+;;# Exercise 3.7
+;;? What is the value of the expression
+(let ((x 1)
+      (y 2)
+      (z 3)
+      (v 5))
+  (cons x 
+	(call/cc (lambda (e) 
+		   (cons y  
+			 (cons z 
+			       (if (even? v) v (e (+ v 1)))))))))
+;; Okay lets start by looking at it:
+;; Okay, we define x y z and v
+;; Then we create a cons with x and the continuations, so the result must be
+;; something like (1 . ???)
+;; If v is even, it will do some cons stuff with the other guys, but it's not.
+;; Therefore the result of (call/cc ...) is (e (+ v 1)) which is 6.
+;; Therefore the result must be (1 . 6)
+
+;; Okay when running it is (1 . 6).
+
+;;# Exercise 3.4
+;;? Program (lambda (a b c) (- (* b b) (* 4 a c))) in CPS
+(define (sub a b k)
+  (k (- a b)))
+(define (mult a b k)
+  (k (* a b)))
+(define (dist a b c k)
+  (mult a c (lambda (v)
+	      (mult 4 v (lambda (v1)
+			  (mult b b (lambda (v2)
+				      (sub v2 v1 k))))))))
+
+(define dist-old (lambda (a b c) (- (* b b) (* 4 a c))))