Added my solutions so far

This commit is contained in:
Emin Arslan 2025-01-02 17:49:30 +03:00
commit 442238a0d5
12 changed files with 716 additions and 0 deletions

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
\#*
*~

43
ex-1-11.rkt Normal file
View File

@ -0,0 +1,43 @@
#lang racket
;; for n=100
;; iterative version takes roughly 0.008 milliseconds.
;; recursive version does not seem like it will finish any time soon.
;; for n=50
;; iterative version takes roughly 0.003 milliseconds in drracket
;; recursive version has not yet finished executing after a couple minutes, and I got bored.
;; for n=25.
;; iterative version takes 0.002ms
;; recursive version takes 46.5 ms
;; yeah. that's big. okay. this shit's important.
;; I wonder how it would be with memoization.
(define-syntax-rule (meas form)
(let ([my-time (current-inexact-milliseconds)])
(let ([res form])
(- (current-inexact-milliseconds) my-time))))
(define (recursive n)
(if (< n 3)
n
(+ (recursive (- n 1))
(* 2 (recursive (- n 2)))
(* 3 (recursive (- n 3))))))
(define (iter a b c n)
(if (<= n 0)
c
(iter b c (+ c (* 2 b) (* 3 a)) (- n 1))))
(define (iter-start n)
(iter 0 1 2 (- n 2)))
(define (ex-1-11 n)
(let loop ((i n))
(if (< i 2)
#t
(if (= (recursive i) (iter-start i))
(loop (- i 1))
(begin
(display "UNEQUAL!")
(displayln i))))))

11
ex-1-16.rkt Normal file
View File

@ -0,0 +1,11 @@
#lang sicp
(define (fast-exp b n)
;(define (even?)); already defined by racket
(define (actual b n a)
(cond
((= n 0) a)
;((= n 1) a)
((even? n) (actual (* b b) (/ n 2) a))
(else (actual b (- n 1) (* a b)))))
(actual b n 1))

17
ex-1-17.rkt Normal file
View File

@ -0,0 +1,17 @@
#lang racket
;; we are told to assume these are already defined.
(define (double x)
(+ x x))
(define (halve x)
(/ x 2))
;; multiplication. defined in terms of addition, double and halve.
;; logarithmic time, constant space.
(define (mult x y)
(define (recc x y a)
(cond
((= y 0) a)
((even? y) (recc (double x) (halve y) a))
(else (recc x (- y 1) (+ a x)))))
(recc x y 0))

36
ex-1-19.rkt Normal file
View File

@ -0,0 +1,36 @@
#lang sicp
;; Yeah okay, this one was extremely satisfying.
;; I just did the calculations on-paper.
;; it's some simple algebra anyway, but I'll type it here:
;; assuming Tpq on (a0, b0):
;; a1 = b0q + a0 * ( p + q)
;; b1 = b0p + a0q
;; a2 = (b0p + a0q) * p + (b0q + a0 * ( p + q)) * (p + q)
;; b2 = (b0p + a0q) * p + (b0q + a0 * ( p + q)) * q
;;
;; rearrange a2 and b2 into a similar form to the definition of a1 and b1:
;; (i.e. define a2 and b2 in terms of a0 and b0 and p and q)
;; a2 = b0 * (q^2 + 2*p*q) + a0 * (2*q^2 + 2*p*q + p^2)
;; b2 = b0 * (p^2 + q^2) + a0 * (q^2 + 2*p*q)
;;
;; from here we can see that p'= p^2 + q^2, and q'= q^2 + 2 * p * q
;; and as a result, we have logarithmic fibonacci!
;; printing the resulting number takes longer than calculating it lmao.
(define (fib n)
(fib-iter 1 0 0 1 n))
(define (fib-iter a b p q count)
(cond ((= count 0) b)
((even? count)
(fib-iter a
b
(+ (* p p) (* q q)) ; compute p
(+ (* q q) (* 2 (* p q))) ; compute q
(/ count 2)))
(else (fib-iter (+ (* b q) (* a q) (* a p))
(+ (* b p) (* a q))
p
q
(- count 1)))))

57
ex-1-29.rkt Normal file
View File

@ -0,0 +1,57 @@
#lang racket
(display "hell yrah")
(define (sum term a next b)
(define (iter a result)
(if (>= a b)
result
(iter (next a) (+ result (term a)))))
(iter a 0))
(define (integral f a b n)
(define h (/ (- b a) n))
(define (apply-f k)
(f (+ a (* k h))))
(define (term k)
(+ (* 4 (apply-f k))
(* 2 (apply-f (+ k 1)))))
(* (/ h 3)
(+ (apply-f 0) (- (apply-f n))
(sum term 1 (λ (x) (+ x 2)) n))))
;;; HOLY SHIT. This has nothing to do with the integral example, I just
;;; found out while reading section 1.3.2 that let is/can be implemented
;;; using just lambdas.
;;; So of course, I wrote a macro to do it.
;;; now I'm wondering what are the absolute minimum amount of primitives
;;; I would need to implement an entire scheme from the ground up.
;;; (Ideally to write a compiler in itself, for itself!)
;;; I guess this kind of thing really puts it into perspective huh.
(define-syntax my-let
(syntax-rules ()
[(_ () body ...) (begin body ...)]
[(_ ([var expr] binding ...) body ...)
((lambda (var) (my-let (binding ...) body ...))
expr) ]))
;;; god. I thought Common Lisp was nice. Scheme and Racket are just something else.
;; some stuff from the next exercise
(define (pn x) (display x) (newline) x)
(define tolerance 0.00001)
(define (fixed-point f first-guess)
(define (close-enough? v1 v2)
(< (abs (- v1 v2))
tolerance))
(define (try guess)
(let ((next (f guess)))
(if (close-enough? guess next)
(pn next)
(try (pn next))
)))
(try first-guess))
; value of phi i think?
(fixed-point (lambda (x) (+ 1 (/ 1 x))) 1)

42
ex-1-37.rkt Normal file
View File

@ -0,0 +1,42 @@
#lang racket
(define (cont-frac nf df k)
(define (recurse i)
(if (>= i k)
0
(/ (nf i) (+ (df i) (recurse (+ 1 i))))))
(recurse 0))
; produces the same result as cont-frac, but
; generates an iterative process.
(define (cont-frac-iterative nf df k)
(define (iterate i numer denom)
(if (<= i 0)
(/ numer denom)
(iterate (- i 1) (nf (- i 1)) (+ (df (- i 1)) (/ numer denom)))))
(iterate (- k 1) (nf k) (df k)))
(define (golden-ratio k)
"cont-frac generates 1/golden ratio, so we just inverse it to get the
real thing. call with k=1000 or something to get an accurate result"
(/ 1.0 (cont-frac-iterative (λ (i) 1.0) (λ (i) 1.0) k)))
;; example 1-38
(define (e-helper i)
(let ((r (remainder (- i 1) 3)))
(if (= 0 r)
(* 2.0 (/ (+ i 2) 3))
1.0)))
(define (eulers-constant k)
"Finds euler's constant. the continued fraction gives e - 2, so we add 2."
(+ 2 (cont-frac-iterative (λ (i) 1.0) e-helper k)))
;; example 1-39
(define (tan-cf x k)
"Finds an approximation of the tangent function. The first numerator is not negative,
even though our numerator function calculates them all as negative, so we need to negate
the result at the end."
(-
(cont-frac-iterative (λ (i) (- (if (<= i 0) x (* x x))))
(λ (i) (- (* 2 (+ i 1)) 1))
k)))

99
ex-1-40-thru-45.rkt Normal file
View File

@ -0,0 +1,99 @@
#lang racket
; definitions from some earlier chapters.
(define (fixed-point f first-guess)
(define tolerance 0.01)
(define (close-enough? v1 v2)
(< (abs (- v1 v2))
tolerance))
(define (try guess)
(let ((next (f guess)))
(if (close-enough? guess next)
next
(try next)
)))
(try first-guess))
; some definitions: these are given by the book.
(define dx 0.00001)
(define (deriv g)
(lambda (x) (/ (- (g (+ x dx)) (g x)) dx)))
(define (newton-transform g)
(lambda (x) (- x (/ (g x) ((deriv g) x)))))
(define (newtons-method g guess)
(fixed-point (newton-transform g) guess))
; example 1-40
(define (cubic a b c)
(λ (x) (+ (expt x 3)
(* a (expt x 2))
(* b (expt x 1))
c)))
; example 1-41
; NOTE: inc isn't defined in racket, so I just defined that too
(define (inc x) (+ 1 x))
(define (double f)
(λ (x) (f (f x))))
(display (((double (double double)) inc) 5))
(newline)
; => 21
; example 1-42
(define (square x) (* x x))
(define (compose f g) (λ (x) (f (g x))))
(display ((compose square inc) 6))
; => 49
; example 1-43
(define (repeated f n)
"This procedure generates an iterative process."
(define (iter ret i)
(if (<= i 1)
ret
(iter (compose f ret) (- i 1))))
(iter f n))
; example 1-44
; procedure average is defined here for convenience
(define (average a b c)
(/ (+ a b c) 3))
(define (smooth f dx)
(λ (x)
(average (f (- x dx))
(f x)
(f (+ x dx)))))
; example asks us to "show" how n-fold smoothing would be done.
; here it is, with the procedure `repeated`
; note we need to pass an anonymous function to do it because the way
; I defined it, `smooth` accepts two arguments, not one.
; thankfully one of the arguments will be the same for all calls,
; so we can just curry it up a little.
(define (some-func x) x) ; assume there is some function we want to smooth.
(define n 2)
((repeated (λ (f) (smooth f 0.001)) n) some-func)
; example 1-45
; this one looks long, I'm skipping for now
; example 1-46
(define (iterative-improve good-enough? improve)
"I use a define here because the returned procedure will be recursive
(an iterative process, but recursive function)
I guess we could use `do` for this but whatever"
(define (ret x)
(if (good-enough? x)
x
(ret (improve x))))
ret)
(define (sqrt n)
"Careful: we're calling iterative-improve, which creates a procedure,
then we're calling the returned procedure with 1 as a parameter."
((iterative-improve
(λ (x) (< (abs (- (* x x) n)) 0.0000001))
(λ (x) (/ (+ x (/ n x)) 2.0)))
2.0))

167
ex-2-20.rkt Normal file
View File

@ -0,0 +1,167 @@
#lang sicp
;; 2.17 : while I was having fun with this,
;; I came up with the following monstrosity
;; yes, it works, and is completely equivalent
;; the second, less horrible implementation
(define (last-pair l)
(or (and (or (null? l) (null? (cdr l))) l)
(last-pair (cdr l))))
(define (last-pair2 l)
(cond
((null? l) l)
((null? (cdr l)) l)
(#t (last-pair2 (cdr l)))))
;; 2.18
(define (reverse l)
(define (iter acc l)
(if (null? l)
acc
(iter (cons (car l) acc)
(cdr l))))
(iter '() l))
(equal? '(4 3 2 1) (reverse '(1 2 3 4)))
;; 2.19
(define (cc amount coin-values)
(define (first-denomination cv)
(car cv))
(define (except-first-denomination cv)
(cdr cv))
(define no-more? null?)
(cond ((= amount 0) 1)
((or (< amount 0) (no-more? coin-values)) 0)
(else
(+ (cc amount
(except-first-denomination
coin-values))
(cc (- amount
(first-denomination
coin-values))
coin-values)))))
;; 2.20
(define (filter f l)
(cond
((null? l) l)
((f (car l)) (cons (car l) (filter f (cdr l))))
(#t (filter f (cdr l)))))
(define (same-parity a . b)
(cons a
(filter (if (even? a) even? odd?)
b)))
(equal? (same-parity 1 2 3 4 5 6) '(1 3 5))
;; 2.21
(define (square x) (* x x))
(define (square-list-direct items)
(if (null? items)
'()
(cons (square (car items)) (square-list-direct (cdr items)))))
(define (square-list-map items)
(map square items))
;; 2.22 this exercise asks for an explanation on why the
;; accumulated result is in reverse order.
;; This is because, at each iteration, the newest item
;; is added to the head of the list - always.
;; this means that the first processed item will be added
;; to the head, then the second, then the third. So
;; the list '(1 2 3) will be processed as such:
;; '(1 2 3) '()
;; '(2 3) '(1)
;; '(3) '(4 1)
;; '() '(9 4 1)
;; So the lists behave like stacks, i.e. FILO ADTs.
;; the "solution" proposed by Louis Reasoner
;; does not work, because that doesn't change the order in
;; which the items are processed or where the items are
;; inserted. It only changes the positions of car and cdr,
;; and in practice this will ruin the structure of the list,
;; nothing more.
;; 2.23
;; a trivial implementation: (just use map and discard result)
(define (trivial-for-each f l)
(map f l)
#t)
;; but this isn't much useful, as the memory is still allocated
;; (if promptly recollected by the GC) for map, defeating the purpose.
;; Here's an implementation that simply ignores the results:
(define (my-for-each f l)
(if (null? l)
#t
(begin (f (car l))
(my-for-each f (cdr l)))))
;; no consing is done, and this generates an iterative process,
;; so no stack allocations either. Equivalent to a for-loop in
;; a language like C or C++.
;; 2.25 - can also be written as: (car (cdaddr l))
(car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))
(car (car '((7))))
; third one's too long. I'll be using cadr to mean (car (cdr x))
(cadr (cadr (cadr (cadr (cadr (cadr '(1 (2 (3 (4 (5 (6 7))))))))))))
;; 2.26 - doesn't require doing anything, just see what they do lol
;; 2.27
;; similar to regular reverse, with the addition that
;; if the current element is itself a list, we cons
;; its reverse instead.
;; O(n) time complexity (where n = leaf count)
;; O(k) space complexity (where k = branch depth? not sure about the correct terminology)
(define (deep-reverse l)
(define (iter acc l)
(cond
((null? l) acc)
((list? (car l)) (iter (cons (deep-reverse (car l)) acc)
(cdr l)))
(#t (iter (cons (car l) acc)
(cdr l)))))
(iter '() l))
;; 2.28
;; ooh, this one's spicy
;; okay, I think I'll first use a recursive process for this,
;; then translate it to an iterative one.
;; Note: iterative process will require a reverse at the end,
;; unless mutable conses are in play. That's why I used sicp lang for this.
(define (fringe l)
(cond
((null? l) l)
((list? (car l)) (append (fringe (car l))
(fringe (cdr l))))
(#t (cons (car l)
(fringe (cdr l))))))
(define (fringe-iter l)
"This is mostly the same actually. We just change the mechanism for adding stuff.
Efficiency-wise, the only difference is that this impl only goes another level
deep for every level of nested lists (instead of going another level deep *at every iteration*)
So, better, but still not perfect if you have a tree a billion levels deep.
The difference here from a typical iterative process is the mutation: instead
of using pure functions I just had the iterator keep track of the end of the list."
(define (add end x)
(let ((c (cons x '())))
(set-cdr! end c)
c))
(define (iter acc-end l)
(cond
((null? l) acc-end)
((list? (car l)) (iter (iter acc-end (car l))
(cdr l)))
(#t (iter (add acc-end (car l))
(cdr l)))))
(let ((sentinel (cons #f '())))
(iter sentinel l)
(cdr sentinel)))

61
ex-2-30.rkt Normal file
View File

@ -0,0 +1,61 @@
#lang racket
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (square x) (* x x))
;; 2.30 oooh, we getting cool now are we?
(define (square-tree l)
(cond
((null? l) l)
((list? (car l)) (cons (square-tree (car l))
(square-tree (cdr l))))
(#t (cons (square (car l))
(square-tree (cdr l))))))
(define (square-tree-map l)
(map (λ (x)
(if (list? x)
(square-tree-map x)
(square x)))
l))
;; 2.31 hohoohoho nice
(define (tree-map f l)
(map (λ (x)
(if (list? x)
(tree-map f x)
(f x)))
l))
(define (square-tree-final l) (tree-map square l))
;; 2.32 hmm.. cool stuff.
(define (subsets s)
(if (null? s)
(list '())
(let ((rest (subsets (cdr s))))
(append rest (map (λ (l) (cons (car s) l)) rest)))))
;; The reason this works, is because the set of subsets of a set s
;; can be defined as such:
;; - if s is the empty set, the result is a set containing the empty set
;; - otherwise, the result is a set containing:
;; 1. the subsets of s without the first element of s
;; 2. the subsets of s with the first element of s
;; 2 can be defined as the first element of s added to every
;; subset of s that does not contain the first element of s.
;; probably not a very rigorous or formal definition, but good
;; enough for now.
;; 2.33
(define (map p sequence)
(accumulate (lambda (x y) ⟨??⟩) nil sequence))
(define (append seq1 seq2)
(accumulate cons ⟨??⟩ ⟨??⟩))
(define (length sequence)
(accumulate ⟨??⟩ 0 sequence))

93
ex-2.1-thru-2.6 Normal file
View File

@ -0,0 +1,93 @@
#lang racket
;; 2.1
(define (normalize n d)
(if (equal? (< n 0) (< d 0))
(cons (abs n) (abs d))
(cons (- (abs n)) (abs d))))
(define (make-rat n d)
(let ([g (gcd n d)])
; if they have the same sign, just take absolutes
(normalize (/ n g) (/ d g))))
(define (print-rat rat)
(display (car rat))
(display "/")
(display (cdr rat))
(newline))
(map print-rat
(map (λ (x) (apply make-rat x))
'((2 3)
(1 2)
(-3 4)
(-100 -4)
(100 -4))))
;; 2.2
;; we are using racket, so we could also define a structure.
;; (struct point (x y))
;; instead we'll keep to the book and use cons cells.
(define point-x car)
(define point-y cdr)
(define point cons)
;; the above could be replaced with
; (struct point (x y))
(define line-p1 car)
(define line-p2 cdr)
(define line cons)
; (struct line (p1 p2))
(define (average a b) (/ (+ a b) 2))
(define (midpoint-segment ls)
(point (average (point-x (line-p1 ls))
(point-x (line-p2 ls)))
(average (point-y (line-p1 ls))
(point-y (line-p2 ls)))))
;; 2.3
;; not sure what the book means here. But I guess we can implement
;; rectangles as pairs, too, since we only need two corners really.
;; as "another representation", I guess we could store two line segments?
;; but either way the rect-p1 and rect-p2
;; functions can be replaced very easily.
;; the area and perimeter functions do not care about their implementation.
(define rect-p1 car)
(define rect-p2 cdr)
(define rect cons)
;; further abstraction, actually: rectangle side 1.
;; returns the length of rect's one side
(define (rect-side-helper rect fun)
(abs (- (fun (rect-p1 rect))
(fun (rect-p2 rect)))))
(define (rect-s1 rect)
(rect-side-helper rect point-x))
(define (rect-s2 rect)
(rect-side-helper rect point-y))
(define (area rect)
(* (rect-s1 rect) (rect-s2 rect)))
(define (perimeter rect)
(* 2 (+ (rect-s1 rect) (rect-s2 rect))))
; 2.6
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 n)
(lambda (f) (lambda (x) (f ((n f) x)))))
(define one (λ (f) (λ (x) (f x)))) ;; applies f once.
(define two (λ (f) (λ (x) (f (f x)))))
;(add-1 zero) ; is the same as
;(lambda (f) (lambda (x) (f ((zero f) x))))
;(lambda (f) (lambda (x) ((add-1 zero) (((add-1 zero) f) x))))
(define (addition n1 n2)
"Returns a function that takes a function f, returns:
A function that takes a parameter x, applies f to x n1 + n2 times
(n1 and n2 being church numerals, i.e. λfλx forms.)"
(lambda (f) (lambda (x)
((n2 f) ((n1 f) x))
)))
(define (de-churchify n)
((n (λ (x) (+ x 1))) 0))

88
ex-2.rkt Normal file
View File

@ -0,0 +1,88 @@
#lang racket
(define (mul-interval x y)
(let ((p1 (* (lower-bound x) (lower-bound y)))
(p2 (* (lower-bound x) (upper-bound y)))
(p3 (* (upper-bound x) (lower-bound y)))
(p4 (* (upper-bound x) (upper-bound y))))
(make-interval (min p1 p2 p3 p4)
(max p1 p2 p3 p4))))
(define (make-interval a b) (cons a b))
(define (add-interval a b)
(make-interval (+ (lower-bound a) (lower-bound b))
(+ (upper-bound a) (upper-bound b))))
;; 2.7
;; simple definitions.
(define upper-bound cdr)
(define lower-bound car)
;; 2.8
(define (interval-diff f a b)
(make-interval (- (lower-bound a) (upper-bound b))
(- (upper-bound a) (lower-bound b))))
;; 2.9 this one's just about reasoning, no programming, and I feel too lazy to explain
;; sorry.
;; 2.10 : simple 'nuff.
(define (div-interval x y)
(if (= (lower-bound y) (upper-bound y))
(error "WHY? WHY MUST YOU TORTURE ME SO?")
(mul-interval
x
(make-interval (/ 1.0 (upper-bound y))
(/ 1.0 (lower-bound y))))))
;; 2.11 : This one's also somewhat simple.
;; we ONLY need more than two multiplications
;; if BOTH intervals have different signs on their upper
;; and lower bounds. otherwise, naive logic works fine.
(define (mul-interval2 x y)
(define (different? n)
(and (< (lower-bound n) 0) (< (upper-bound n) 0)))
(if (and (different? x) (different? y))
(let ((p1 (* (lower-bound x) (lower-bound y)))
(p2 (* (lower-bound x) (upper-bound y)))
(p3 (* (upper-bound x) (lower-bound y)))
(p4 (* (upper-bound x) (upper-bound y))))
(make-interval (min p1 p2 p3 p4)
(max p1 p2 p3 p4)))
(make-interval (* (lower-bound x) (lower-bound y))
(* (upper-bound x) (upper-bound y)))))
;; 2.12 : simple nuff.
(define (make-center-width c w)
(make-interval (- c w) (+ c w)))
(define (center i)
(/ (+ (lower-bound i) (upper-bound i)) 2))
(define (width i)
(/ (- (upper-bound i) (lower-bound i)) 2))
(define (make-center-percent c p)
(make-center-width c (* c (/ p 100))))
(define (percent i)
(* (/ (width i) 2) 100))
;; 2.13 & 2.14
(define (par1 r1 r2)
(div-interval (mul-interval r1 r2)
(add-interval r1 r2)))
(define (par2 r1 r2)
(let ((one (make-interval 1 1)))
(div-interval
one (add-interval (div-interval one r1)
(div-interval one r2)))))
(define A (make-interval 100 101))
(define B (make-interval 200 201))
(div-interval A A)
(div-interval (make-interval 1 1) A)
(div-interval B A)