#lang racket

(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)
  (cons h (pack t)))
;; define-syntax-rule definește o construcție nestrictă,
;; deci apelul stream-cons nu va evalua h și 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 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)
;    (display "build for") (displayln 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 limited-expand-string ; limitează rezultatul lui expand-string la lungimea len
  (λ (len) (λ (s) ; definiție curry
             (filter (λ (x) (<= (length x) len)) (expand-string s)))))

(define BFS-one  ;; găsește prima soluție și o întoarce
  (λ (init expand goal?)
    (let search ((open (list init)))  ;; open = valori de explorat
      (if (null? open)
          #f  ;; am terminat de explorat și nu am găsit soluție
          (let ((next (car open))) ; următoarea valoare de explorat
            (if (goal? next)
                next ;; am găsit o soluție
                (search (append (cdr open) (expand next)))
                ;; stările nou descoperite se adaugă la sfârșit
                ))))))

(define first-palindrome (BFS-one '() expand-string (n-palindrome? 3)))
first-palindrome

(define BFS ;; găsește toate soluțiile (spațiul de căutare trebuie să fie finit)
  (λ (init expand goal?)
    (let search ((open (list init)))  ;; open = valori de explorat
      (if (null? open)
          '() ;; am terminat de explorat
          (let ((next (car open))) ; următoarea valoare de explorat
            (append
             (if (goal? next) (list next) '())
             (search (append (cdr open) (expand next)))
             ))))))

(define 3-palindromes (BFS '() (limited-expand-string 4) (n-palindrome? 3)))
3-palindromes



(define BFS-lazy ;; produce un flux de soluții, pe baza unui spațiu de căutare potențial infinit
  (λ (init expand goal?)
    (let search ((open (list init)))  ;; open = valori de explorat
      (if (null? open)
          '() ;; am terminat de explorat
          (let* ((next (car open)) ; următoarea valoare de explorat
                 (other-solutions (delay (search (append (cdr open) (expand next)))))
                 ;; calculez other-solutions doar dacă am nevoie de ele
                 ;; stările nou descoperite se adaugă la sfârșit
                 )
            (if (goal? next)
                ;; la găsirea unei soluții, restul căutării va fi lăsat
                ;; până când este necesară o nouă soluție (ceea ce va forța evaluarea lui cdr din
                ;; fluxul de stări, și deci evaluarea lui search)
                (stream-cons next (force other-solutions))

                ;; altfel, încep în căutarea următoarelor soluții
                (force other-solutions)
                ))))))

(define all-palindromes
  (BFS-lazy '() expand-string palindrome?))
(stream-take all-palindromes 6)
; al 50-lea palindrom
(stream-car (stream-drop all-palindromes 50))