#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)
  (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 (stream-null? s1) s2
      (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 (list->stream L)
  (if (null? L) stream-nil
      (stream-cons (car L) (list->stream (cdr L)))))

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


(display "ones:\n")

;(define ones (letrec ((ones (cons 1 ones))) ones)) ; eroare
;(define (ones) (cons 1 (ones)))  ;ciclu infinit
;(define ones (cons 1 (λ () ones))) ; inchideri
;(define ones (cons 1 (delay ones))) ; promisiuni
(define ones (stream-cons 1 ones))

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

(define (naturals-from start) ; observați evaluarea la utilizarea promisiunilor
  (stream-cons start (naturals-from ;  ca mecanism de întârziere a evaluării
                      (and (display `(build ,(+ start 1))) (+ start 1)))))
;(define (naturals-from start) 
;  (stream-cons start
;               (naturals-from (+ start 1))))
(define naturals (naturals-from 0))

(define naturals2
  (stream-cons 0 (stream-zip-with + ones naturals2)))

(display "naturals:\n")
(stream-take naturals 0)
(stream-take naturals 1)
(stream-take naturals 5)
(stream-take naturals 7)

(stream-take naturals2 5)

(define even-naturals (stream-filter even? naturals))
(display "even naturals:\n")
(stream-take even-naturals 5)

(define even-naturals2 (stream-zip-with + naturals naturals))
(stream-take even-naturals 5)

(define (sieve numbers)
  (stream-cons (stream-car numbers)
               (sieve
                (stream-filter
                 (λ (n) (not (zero? (remainder n (stream-car numbers)))))
                 (stream-cdr numbers)))))

(define primes (sieve (naturals-from 2)))
(display "primes:\n")
(stream-take primes 10)



; =============================================== GRAPHS
(display "Grafuri:\n")

(define (make-directed-graph V E) (cons V E))
(define get-nodes car)
(define get-edges cdr)
(define (outgoing G v) (map cadr (filter (λ (e) (equal? (car e) v)) (get-edges G))))


(define (curry f NTotal) (let c-R ((N NTotal) (args '())) (if (zero? N) (apply f (reverse args))
                                                              (λ (arg) (c-R (- N 1) (cons arg args))))))
(define (in-sol n partSol) (ormap ((curry assoc 2) n) partSol))

(define (dfs-one G v . listsolution)
  (reverse (let dfs-R ((c-node v) (local-H (list (cons v 'none))))
             (foldl (λ (child history)
                      (if (or (assoc child history) (in-sol child (car listsolution)))
                          history
                          (dfs-R child (cons (cons child c-node) history))
                          )) local-H (outgoing G c-node))
             )))

(define (dfs G)
  (foldl (λ (node solution)
           (if (in-sol node solution) solution
               (append solution (list (dfs-one G node solution)))
               )) '() (get-nodes G)))

(define G1 (make-directed-graph
            '(2 3 5 7 8 9 10 11)
            '((3 8) (3 10) (5 11) (7 8) (7 11) (8 9) (11 2) (11 9) (11 10))))
(dfs G1)



(display "Graf infinit:\n")

(random-seed 5728)
(define max-v 10)
(define (rand-edge) (list (random max-v) (random max-v)))
(define (Edges-gen) (stream-cons (rand-edge) (Edges-gen)))
(define InfiniGraph 
  (make-directed-graph naturals (Edges-gen)))

(stream-take (get-nodes InfiniGraph) 10)
(stream-take (get-edges InfiniGraph) 10)


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

(define (lazy-outgoing G v)
  (stream-map cadr 
              (stream-filter 
               (λ (e) (equal? (car e) v))
               (list->stream (stream-take (get-edges G) 10)))))


(define (lazy-dfs-one G v . listsolution)
  (let dfs-R ((node v) 
              (local-H (list->stream
                        (list (cons v 'none))))
              (MAXDepth -1))
    (if (zero? MAXDepth) local-H
        (let visit-children ((children (lazy-outgoing G node))
                             (history local-H))
          (if (stream-null? children) history
              (let ((child (stream-car children)))       
                (if (or (stream-assoc child history)
                        (stream-assoc child (car listsolution)))
                    history
                    (dfs-R
                     child
                     (stream-append history (list->stream (list (cons child node))))
                     (- MAXDepth 1)))
                ))))))
(define (lazy-dfs G)
  (let lazy-dfs-R ((nodes (get-nodes G))
                   (solution stream-nil))
    (if (stream-assoc (stream-car nodes) solution)
        solution
        (lazy-dfs-R (stream-cdr nodes)
                    (stream-append solution
                                   (lazy-dfs-one G (stream-car nodes) solution))))
    ))

(stream-take (lazy-dfs InfiniGraph) 10)





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


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

(define breadth-search-goal
  (lambda (init expand goal?)
    (letrec ((search
              (lambda (states)
                (if (null? states) '()
                    (let ((state (car states))
                          (states (cdr states)))
                      (if (goal? state) state
                          (search (append states (expand state)))))))))
      (search (list init)))))


;(display "Fluxul stărilor\n")

(define lazy-breadth-search
  (lambda (init expand)
    (letrec ((search
              (lambda (states)
                (if (stream-null? states) states
                    (let ((state (stream-car states))
                          (states (stream-cdr states)))
                      (stream-cons state (search (stream-append states (expand state)))))))))
      (search (stream-cons init stream-nil)))))


;(display "Fluxul stărilor goal\n")

(define lazy-breadth-search-goal
  (lambda (init expand goal?)
    (stream-filter goal? (lazy-breadth-search init expand))))


;(display "Fluxul palindroamelor\n")

(define palindromes
  (lambda (n symbols)
    (let ((symbol-stream (list->stream symbols)))
      (lazy-breadth-search-goal '()
                                (lambda (state)
                                  (stream-map (lambda (symbol) (cons symbol state))
                                              symbol-stream))
                                (lambda (state)
                                  (and (>= (length state) n) (equal? state (reverse state))))))))

(stream-take (palindromes 2 '(a b)) 10)


(display "Problema reginelor\n")

; board -> '((1 . 2) (2 . 4) (3 . 1) (4 . 3))

(define queens
  (lambda (n)
    (lazy-breadth-search-goal '()
                              (expandq n)
                              (lambda (board)
                                (= (length board) n)))))

(define lin car)
(define col cdr)

(define conflict?
  (lambda (q1 q2)
    (or (= (lin q1) (lin q2))
        (= (col q1) (col q2))
        (= (abs (- (lin q1) (lin q2)))
           (abs (- (col q1) (col q2)))))))

(define forall?
  (lambda (p? l)
    (foldl (lambda (x y) (and x y)) #t (map p? l))))

(define expandq
  (lambda (n)
    (lambda (board)
      (let ((line (+ (length board) 1))
            (columns (let func ((n n))
                       (if (zero? n) '()
                           (cons n (func (- n 1)))))))
        (if (> line n) '()
            (map (lambda (column)
                   (cons (cons line column) board))
                 (filter (lambda (column)
                           (forall? (lambda (queen)
                                      (not (conflict? queen (cons line column))))
                                    board))
                         columns)))))))

(stream-take (queens 8) 10)