aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJulian T <julian@jtle.dk>2021-09-28 22:24:02 +0200
committerJulian T <julian@jtle.dk>2021-09-28 22:24:02 +0200
commitacbf2d03baf8c63ad14c440d12def0a45c3b2cd6 (patch)
tree185154fd12e0d82994d756750ee6b380f967a459
parent9784dd520a72b775641d649153101f4672139a9e (diff)
Add exercises for pp lecture 2 and 3
-rw-r--r--sem7/pp/lec2.scm99
-rw-r--r--sem7/pp/lec3.scm125
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))))