Cwiczenia 6.06.18

#lang racket

;; cw. 1

(define (incorrect-password amount) 'incorrect-password)

(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch p m)
    (if (eq? password p)
        (cond ((eq? m 'withdraw) withdraw)
              ((eq? m 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT"
                           m)))
        (incorrect-password))) ;amount)))
  dispatch)

;; cw. 2

(define (make-cycle xs)
  (define (iter ys)
    (if (null? (mcdr ys))
        (set-mcdr! ys xs)
        (iter (mcdr ys))))
  (if (null? xs)
      (error "Empty list!" xs)
      (iter xs)))

(define l
  (mcons 1 (mcons 2 null)))

; #0 - wskaźnik/zmienna oznaczająca listę cykliczną
; na końcu #0#

;; cw. 3

(define (has-cycle? xs)
  (define (iter ys zs)
    (if (or (null? zs)
            (null? (mcdr zs)))
        #f
       (if (eq? (mcdr ys) (mcdr (mcdr zs)))
           #t
           (iter (mcdr ys) (mcdr (mcdr zs))))))
  (iter xs xs))

;; cw. 4

(define (make-monitored f)
  (let ((counter 0))
    (define (eval args)
      (begin (set! counter (+ counter 1))
             (apply f args)))
    (define (how-many?) counter)
    (define (reset) (set! counter 0))
    (define (dispatch m)
      (cond [(eq? m 'eval) eval]
            [(eq? m 'how-many?) how-many?]
            [(eq? m 'reset) reset]
            [else (error "Unknown request -- MAKE-MONITORED"
                         m)]))
  dispatch))

(define (m-monitored f)
  (let ((counter 0))
    (cons (lambda xs
            (begin (set! counter (+ counter 1))
                   (apply f xs)))
          (lambda (x)
            (if (eq? x 'how-many?)
                     counter
                     (set! counter 0))))))

;; cw. 5


;(define (lcons x f)
;  (cons x f))

(define (lhead l)
  (car l))

(define (ltail l)
  ((cdr l)))

(define (ltake n l)
  (if (or (null? l) (= n 0))
      null
      (cons (lhead l)
            (ltake (- n 1) (ltail l)))))

(define (lfilter p l)
  (cond [(null? l) null]
        [(p (lhead l))
         (lcons (lhead l)
                (lambda ()
                  (lfilter p (ltail l))))]
        [else (lfilter p (ltail l))]))

(define (lmap f . ls)
  (if (ormap null? ls) null
      (lcons (apply f (map lhead ls))
             (lambda ()
               (apply lmap (cons f (map ltail ls)))))))

;; ciąg Fibonacciego

;; spamiętywanie

(define (memo-proc proc)
  (let ((already-run? false) (result false))
    (lambda ()
      (if (not already-run?)
          (begin (set! result (proc))
                 (set! already-run? true)
                 result)
          result))))

(define (lcons x f)
  (cons x (memo-proc f)))

(define fib
  (lcons 0
         (lambda ()
           (lcons 1
                  (lambda ()
                    (lmap + fib (ltail fib)))))))

;; cw. 6

(define fact
  (lcons 1
         (lambda () (lmap * (integers-starting-from 1)
                          fact))))

;; cw. 7

(define (sum ll)
  (define result
    (lcons 0
           (lambda () (lmap + ll result))))
  result)

;; cw. 8

(define (merge xs ys)
  (let ((x (lhead xs))
        (y (lhead ys)))
    (cond [(< x y)
           (lcons x (lambda () (merge (ltail xs) ys)))]
          [(< y x)
           (lcons y (lambda () (merge xs (ltail ys))))]
          [else
           (lcons x (lambda () (merge (ltail xs) (ltail ys))))])))

;;num235

(define num2
  (lcons 1
         (lambda () (lmap (lambda (x) (* x 2)) num2))))

(define num23
  (lcons 1
         (lambda () (merge (lmap (lambda (x) (* x 2)) num23)
                           (lmap (lambda (x) (* x 3)) num23)))))

(define num235
  (lcons 1
         (lambda () (merge
                     (merge (lmap (lambda (x) (* x 2)) num235)
                            (lmap (lambda (x) (* x 3)) num235))
                     (lmap (lambda (x) (* x 5)) num235)))))



;dzieki result odwolujemy sie do tego samego strumienia
;a w (sum ll) zawsze nowy odkladany na stercie
;dlatego (last (ltake 100000 (sum naturals))) wykona sie w 1s.


;; alternatywna implementacja wykorzystująca listy modyfikowalne

;(define (lcons x f)
;  (mcons x f))

;(define (lhead l)
;  (mcar l))

;(define (ltail l)
;  (when (procedure? (mcdr l))
;      (set-mcdr! l ((mcdr l))))
;  (mcdr l))

;; dodatkowy przykład: liczby pierwsze

(define (integers-starting-from n)
  (lcons n (lambda () (integers-starting-from (+ n 1)))))

(define naturals (integers-starting-from 0))

(define (divisible? x y) (= (remainder x y) 0))
(define no-sevens
  (lfilter (lambda (x) (not (divisible? x 7)))
           naturals))

(define (sieve stream)
  (lcons
   (lhead stream)
   (lambda ()
     (sieve (lfilter
             (lambda (x)
               (not (divisible? x (lhead stream))))
             (ltail stream))))))

(define primes (sieve (integers-starting-from 2)))