#lang racket
; Mihnea Muraru & Andrei Olaru

;(display "----- Operatori pe fluxuri -----\n")

(define-syntax-rule (pack expr)
  ;  (lambda () expr)) ; închideri
  (delay expr)) ; promisiuni

;(define unpack (λ (package) (package))) ; închideri
(define unpack force) ; promisiuni



; =====================================
(define-syntax-rule (stream-cons h t)
  ;; define-syntax-rule definește o construcție nestrictă,
  ;; deci apelul stream-cons nu va evalua h și t
  (cons h (pack t)))

(define stream-car car)

(define (stream-cdr s)
  (unpack (cdr s)))

(define stream-nil '())

(define stream-null? null?)




; ===============================

(define (stream-take s n)
  (cond ((zero? n) '())
        ((stream-null? s) '())
        (else (cons (stream-car s) (stream-take (stream-cdr s) (- n 1))))))

(define (stream-drop s n)
  (cond ((zero? n) s)
        ((stream-null? s) s)
        (else (stream-drop (stream-cdr s) (- n 1)))))

(define (stream-map f s)
  (if (stream-null? s) s
      (stream-cons (f (stream-car s))
                   (stream-map f (stream-cdr s)))))

(define (stream-filter f? s)
  (cond ((stream-null? s) s)
        ((f? (stream-car s)) (stream-cons (stream-car s) (stream-filter f? (stream-cdr s))))
        (else (stream-filter f? (stream-cdr s)))))

(define (stream-zip-with f s1 s2)
  (if (or (stream-null? s1) (stream-null? s2)) stream-nil
      (stream-cons (f (stream-car s1) (stream-car s2))
                   (stream-zip-with f (stream-cdr s1) (stream-cdr s2)))))

(define (stream-append s1 s2)
  (if (stream-null? s1) s2
      (stream-cons (stream-car s1)
                   (stream-append (stream-cdr s1) s2))))

(define (stream-assoc k s)
  (cond
    ((stream-null? s) #f)
    ((equal? (car (stream-car s)) k) (stream-car s))
    (else (stream-assoc k (stream-cdr s)))))

(define (list->stream L)
  (if (null? L) stream-nil
      (stream-cons (car L) (list->stream (cdr L)))))

; ===============================================
;(display "----- Definiri de fluxuri -----\n")

;(display "ones:\n")

; construim o listă infinită de numărul 1, care se numește ones
; (car ones) -> 1
; (car (cdr ones)) -> 1
; (car (cdr (cdr ones))) -> 1
; ....
; (car (cdr (cdr .... (cdr ones) ... ))) -> 1


;(define ones (cons 1 ones)) ; eroare, definiția lui ones nu este vizibilă în propria valoare
;(define ones (letrec ((ones (cons 1 ones))) ones)) ; eroare (ar fi funcționat
;   dacă ones era utilizat într-o închidere funcțională)
;(define (ones) (cons 1 (ones)))  ; ciclează infinit -> aș vrea ca (ones) să se apeleze doar când am nevoie
;(define ones (cons 1 (λ () ones))) ; inchideri
;(define ones (cons 1 (delay ones))) ; promisiuni
(define ones (stream-cons 1 ones))
; ATENȚIE: există și în racket definit stream-cons & co, în biblioteca racket/stream.
; stream-cons din Racket întoarce un obiect de tip #<stream>

(car ones)
(cdr ones)
(equal? ones (stream-cdr ones))


; cu funcție recursivă
(display "naturals:\n")
(define (naturalsFrom start)
  (stream-cons start
               (naturalsFrom (add1 start))))
(define naturals (naturalsFrom 0))

; cu funcție recursivă în named let
(define naturals2 (let naturalsFrom ((start 0))
                    (stream-cons start (naturalsFrom (add1 start))))
  )
(stream-take naturals 10)
(stream-take naturals2 10)

(display "Powers of 2: ")
(define pow2 (let build ((start 1))
               (stream-cons start (build (* 2 start)))))

(stream-take pow2 20)


(display "primes: ")
(define primes
  (let sieve ((numbers (naturalsFrom 2)))
    (stream-cons (stream-car numbers)
                 (sieve (stream-filter (λ (n) (not (zero? (remainder n (stream-car numbers)))))
                                       numbers))
                 )))
(stream-take primes 20)


(define fibb
  (stream-cons 0
               (stream-cons 1
                            (let build ((prevprev 0) (prev 1))
                              (let ((current (+ prevprev prev)))
                                (stream-cons current
                                             (build prev current))
                                )))))
(stream-take fibb 10)


; construcție a unui flux be baza lui însuși
;(define naturals3 (let naturalsFrom ((start 0))
;                    (display start)
;                    (cons start (naturalsFrom (add1 start))))
;  )

(define naturals4
  (stream-cons 0 (stream-map add1 naturals4)))
(stream-take naturals4 10)


(define fibb2
  (stream-cons
   0
   (stream-cons
    1
    (stream-zip-with +
                     fibb2
                     (stream-cdr fibb2)
                     ))))
(stream-take fibb2 10)


(define pow2-2
  (stream-cons 1
               (stream-zip-with +
                                pow2-2
                                pow2-2)))
(stream-take pow2-2 10)


(define evens
  (stream-zip-with + naturals naturals))
(stream-take evens 10)




; =============================================== LAZY BFS
(display "----- Căutare leneşă în spaţiul stărilor -----\n")

(display "Găsirea primei stări scop\n")

(define symbols '(a b c)) ;; alfabetul pentru palindroame
(define expand-string ;; pe baza lui s, mai construiește o serie de șiruri, de lungime + 1
  (λ (s) (map (λ (symb) (cons symb s)) symbols)))
(define palindrome? (λ (s) (equal? s (reverse s))))
(define (n-palindrome? n) (λ (s) (and (equal? n (length s)) (palindrome? s)))) ; curry

(define BFS-one ;; găsește prima soluție și o întoarce
  (λ (init expand goal?)
    (let search ((frontier (list init))) ;; stări de explorat
      ;(display frontiera)
      (if (null? frontier) #f  ;; am terminat de explorat și nu am găsit soluție
          (let ((node (car frontier))) ;; stare curentă
            (if (goal? node)
                node ;; am găsit o stare scop (o soluție)
                (search (append (cdr frontier) (expand node))))
            ;; stările nou descoperite se adaugă la sfârșit
            )))
    ))
;; primul palindrom de lungime 3:
(BFS-one '() expand-string (n-palindrome? 3))


(define BFS ;; găsește toate soluțiile (spațiul de căutare trebuie să fie finit)
  (λ (init expand goal?)
    (let search ((frontier (list init))) ;; stări de explorat
      ;(display frontiera)
      (if (null? frontier) '()  ;; am terminat de explorat?
          (let* ((node (car frontier)) ; stare curentă
                 (other-solutions ;; rezultatul căutării recursive
                  (search (append (cdr frontier) (expand node)))))
            ;; stările nou descoperite se adaugă la sfârșit
            (if (goal? node)
                (cons node other-solutions) ;; am găsit o stare scop (o soluție)
                other-solutions)
            )))
    ))

(define limited-expand-string ; limitează rezultatul lui expand-string la lungimea len
  (λ (len) (λ (s) ; definiție curry
             (filter (λ (x) (<= (length x) len)) (expand-string s)))))
; alternativ:
;(define limited-expand-string (compose ((curry filter) (compose ((curry >=) 3) length)) expand-string))

(define 3-palindromes (BFS '()
                           (limited-expand-string 3)
                           palindrome?))
(display "palindroame de lungime 3: ")
3-palindromes



(define BFS-lazy ;; găsește toate soluțiile (spațiul de căutare trebuie să fie finit)
  (λ (init expand goal?)
    (let search ((frontier (list init))) ;; stări de explorat
      ;(display frontiera)
      (if (null? frontier) '()  ;; am terminat de explorat?
          (let* ((node (car frontier))) ; stare curentă
            ;; stările nou descoperite se adaugă la sfârșit
            ;(display frontier)(newline)
            (if (goal? node)
                (stream-cons node (search (append (cdr frontier) (expand node)))) ;; am găsit o stare scop (o soluție)
                (search (append (cdr frontier) (expand node))))
            )))
    ))

(define palindromes
  (BFS-lazy '() expand-string palindrome?))
(stream-car (stream-drop palindromes 100))

(displayln "palindroamele de la 50 la 60:")
(stream-take (stream-drop palindromes 50) 10)


; o implementare alternativă

(define levels-stream
  (stream-cons '(()) ; primul nivel conține doar șirul gol
               (stream-map (compose
                            ((curry apply) append) ; facem flatten după ce
                            ((curry map) expand-string)) ; am expandat întreg nivelul
                           levels-stream)))            ; și formăm un nou nivel
;(stream-take levels-stream 3)

(define search-space ; forma flat pentru niveluri
  (let build ((cLevel '()) (levels levels-stream))
    (if (null? cLevel) (build (stream-car levels) (stream-cdr levels))
        (stream-cons (car cLevel) (build (cdr cLevel) levels)))))
;(stream-take search-space 20)

(define lean-palindromes (stream-filter palindrome? search-space))
(displayln "palindroamele de la 50 la 60:")
(stream-take (stream-drop lean-palindromes 50) 10)