Racket (preparation for funcprog exams)

racket1.rkt

#lang racket

; collection of various functions as test preparation

; mycons
(define (mycons a b)
  (λ (m)
    (cond [(= m 0) a]
          [(= m 1) b]
          [else (error 'mycons "expected argument 0 or 1, given: ~a" m)])))

; list-ref
(define (list-ref xs n)
  (if (= n 0) (car xs)
      (list-ref (cdr xs) (- n 1))))

; length
(define (length xs)
  (if (null? xs) 0
      (+ 1 (length (cdr xs)))))

; append
(define (myappend xs ys)
  (if (null? xs) ys
      (cons (car xs) (myappend (cdr xs) ys))))

; last
(define (last xs)
  (if (null? (cdr xs)) (car xs)
      (last (cdr xs))))

; reverse with append
(define (reverse xs)
  (if (null? (cdr xs)) (list (car xs))
      (append (reverse (cdr xs)) (list (car xs)))))

; TODO
; reverse with cons
(define (reverse2 xs)
  (if (null? (cdr xs)) (car xs)
      (cons (reverse2 (cdr xs)) (cons (car xs) null))))

; map
(define (mymap func xs)
  (if (null? xs) null
      (cons (func (car xs)) (mymap func (cdr xs)))))

; TODO
; foldr
(define (myfold proc xs)
  (if (null? (cdr xs)) (car xs)
      (proc (car xs) (myfold proc (cdr xs)))))

(define (myfoldr proc init xs)
  (proc (myfold proc xs) init))

(define (myfoldl proc init xs)
  (proc (myfold proc xs) init))

; range
(define (range a b)
  (if (>= a b) null
      (cons a (range (+ a 1) b))))

; length using foldr
(define (mylength xs)
  (foldr (λ (a b) (+ b 1)) 0 xs))

; map using foldr
(define (mymapf proc xs)
  (foldr (λ (x prev) (cons (proc x) prev)) null xs))

; merge alternating
(define (merge xs ys)
  (cond [(null? xs) ys]
        [(null? ys) xs]
        [else (cons (car xs) (merge ys (cdr xs)))]))

; take
(define (mytake xs n)
  (if (= n 0) null
      (cons (car xs) (mytake (cdr xs) (- n 1)))))

; drop
(define (mydrop xs n)
  (if (= n 0) xs
      (mydrop (cdr xs) (- n 1))))


; withdraw
(define (make-withdraw balance)
  (λ (amount)
    (if (>= balance amount) 
        (begin (set! balance (- balance amount)) balance)
        "Insufficient funds!")))

(define (make-bankaccount balance)
  (λ (action amount)
    (cond [(eq? action 1) (begin (set! balance (+ balance amount)) balance)]
          [(eq? action 2)
           (if (>= balance amount) (begin (set! balance (- balance amount)) balance)
               "Insufficient funds")]
          [else (error 'make-bankaccount "Invalid action, given: ~a, expected 1 (deposit) or 2 (withdraw)" action)])))
                          
(define (make-bankaccount2 balance)
  (define (withdraw amount)
    (if (>= balance amount) (begin (set! balance (- balance amount)) balance)
               "Insufficient funds"))
  (define (deposit amount)
    (begin (set! balance (+ balance amount)) balance))
  (define (dispatch m)
    (cond [(eq? m 'deposit) deposit]
          [(eq? m 'withdraw) withdraw]           
          [else (error 'make-bankaccount2 "Invalid action, given: ~a, expected 'deposit or 'withdraw" m)]))
  dispatch)

; selfmade cons with set-car! and set-cdr!
(define (mycons2 x y)
  (define (set-car! new-x)
    (set! x new-x))
  (define (set-cdr! new-y)
    (set! y new-y))
  (define (dispatch m)
    (cond [(eq? m 'car) x]
          [(eq? m 'cdr) y]
          [(eq? m 'set-car!) set-car!]
          [(eq? m 'set-cdr!) set-cdr!]
          [else (error 'mycons "Invalid argument, expected 'car or 'cdr, given ~a" m)]))
  dispatch)

(define (mycdr x)
  (x 'cdr))

(define (mycar x)
  (x 'car))

(define (set-cdr! x new-cdr)
  ((x 'set-cdr!) new-cdr))

(define (set-car! x new-car)
  ((x 'set-car!) new-car))

; for tests
(define list1 '(1 2 3 4 5))
(define list2 '(6 7 8 9 10))


; stream-map
(define (mystream-map proc s)
  (if (stream-empty? s) empty-stream
      (stream-cons (proc (stream-first s)) (mystream-map proc (stream-rest s)))))

; delay
(define (delay proc)
  (λ () proc))

; force
(define (force delayed-object)
  (delayed-object))

; stream-cons
(define (my-stream-cons a b)
  (cons a (delay b)))

; stream-car
(define (stream-car s)
  (car s))

; stream-cdr
(define (stream-cdr s)
  (force (cdr s)))

; prime?
(define (divisible? a b)
  (= (modulo a b) 0))

(define (quersumme x)
  (if (<= x 0) 0
      (+ (modulo x 10) (quersumme (quotient x 10)))))

(define (prime? x)
  (define (check-prime x n)    
    (cond 
      [(> (* n n) x) #t]
      [(divisible? x n) #f]
      [else (check-prime x (+ n 2))]))
  (cond 
    [(or (= x 1) (= x 2)) #t]
    [(divisible? x 2) #f]
    [(and (> x 3) (divisible? (quersumme x) 3)) #f]
    [else (check-prime x 5)]))
      
; stream-range
(define (stream-range a b)
  (if (>= a b) empty-stream
      (stream-cons a (stream-range (+ a 1) b))))

; iter-improve
(define (make-iter-improve-func improve good-enough?)
  (define (improve-func x guess)
    (if (good-enough? x guess) guess
        (improve-func x (improve x guess))))
  improve-func)

(define (square x) (* x x))

(define (average a b)
  (/ (+ a b) 2))

(define (improve-sqrt x guess)
  (average guess (/ x guess)))

(define (good-enough-sqrt? x guess)
  (<= (abs (- x (square guess))) 0.0000001))

(define iter-improve-sqrt (make-iter-improve-func improve-sqrt good-enough-sqrt?))

; iter-improve-stream

(define (make-iter-improve-stream improve)
  (define (improve-func x guess)
    (stream-cons guess (improve-func x (improve x guess))))
  improve-func)

(define iter-improve-stream-sqrt (make-iter-improve-stream improve-sqrt))

; count-leaves
(define (count-leaves xs)
  (cond [(null? xs) 0]
        [(not (pair? xs)) 1]
        [else (+ (count-leaves (car xs)) (count-leaves (cdr xs)))]))

; reverse
(define (reverse3 xs)
  (if (null? xs) null
      (append (reverse3 (cdr xs)) (list (car xs)))))

; deep-reverse
; first try, led to nowhere...
(define (deep-reverse2 xs)
  (define (dri xs)
    (cond [(null? xs) null]          
          [(not (pair? xs)) xs]
          [(list? (car xs)) (list (dri (car xs)))]))
  (append (dri (cdr xs)) (list (dri (car xs)))))

; my solution with some help from http://community.schemewiki.org/?sicp-ex-2.27
(define (deep-reverse xs)
  (cond [(null? xs) null]
        ;deep-reverse (car xs) if it's a list:
        [(pair? (car xs)) (append (deep-reverse (cdr xs)) (list (deep-reverse (car xs))))] 
        ; no need to deep-reverse (car xs) if it's not a list:
        [else (append (deep-reverse (cdr xs)) (list (car xs)))]))

; solution taken from instructor's notes but obviously copied from http://community.schemewiki.org/?sicp-ex-2.27
(define (deep-reverse3 xs)
  (if (list? xs)
      (reverse (map deep-reverse3 xs))
      xs))

; another solution from http://community.schemewiki.org/?sicp-ex-2.27
(define (deep-reverse4 x) 
   (if (pair? x) 
       (append (deep-reverse4 (cdr x))  
               (list (deep-reverse4 (car x)))) 
       x)) 


; scale-tree
(define (scale-tree tree func)
  (cond [(null? tree) null]
        [(not (pair? tree)) (func tree)]
        [else (cons (scale-tree (car tree) func) (scale-tree (cdr tree) func))]))

; scale-tree with map (SICP)
(define (scale-tree2 tree fact)
  (map (λ (x) (if (pair? x) (scale-tree2 x fact) (* x fact))) tree))

; accumulator SICP ex-3.1 
(define (make-accumulator val)
  (λ (x) (begin (set! val (+ val x)) val)))

; make-monitored SICP ex-3.2
(define (make-monitored proc)
  (define calls 0)
  (λ (m) (cond
           [(eq? m 'how-many-calls?) calls]
           [(eq? m 'reset-counter) (set! calls 0)]
           [else (begin (set! calls (+ calls 1)) (proc m))])))



;Aufgabe 5.2
(define h 0.0001)

(define (diff f)
  (define (g x)
    (/ (- (f (+ x h)) (f x)) h))
  g)

; Aufgabe 4.2
(define (fringe x)
  (cond [(null? x) null]
         [(not (pair? x)) (list x)]
         [else (append (fringe (car x)) (fringe (cdr x)))]))

; Aufgabe 5.3
(define (equal-fringe xs ys)
  (equal? (fringe xs) (fringe ys)))

; Aufgabe 5.4
;with cons
(define (funcList n)
  (define (list-generator n)
    (if (= n 0) (list (λ (x) (+ x 0)))
    (cons (λ (x) (+ x n)) (list-generator (- n 1)))))
  (reverse (list-generator n)))

;with append (notice append needs lists as inputs)
(define (funcList2 n)
  (define (list-generator n)
    (if (= n 0) (list (λ (x) (+ x 0)))
    (append (list (λ (x) (+ x n))) (list-generator (- n 1)))))
  (reverse (list-generator n)))

; Aufgabe 4.1
;(define (calc amount bills-and-coins)
;  (cond [