#lang racket

(define (stream-zip-with f . argstreams) ;; merge pe oricâte argumente, nu se poate copia în loc de funcția din lab5
  (if (stream-empty? (car argstreams))
      empty-stream
      ;; un flux cu (f first1 first2 ... firstn) si apel rec
      (stream-cons
       (begin
         (apply f (map stream-first argstreams)))
       (apply stream-zip-with f (map stream-rest argstreams)))))
(define naturals
  (let loop ((n 0))
    (stream-cons n (loop (add1 n)))))
(define (show s n)
  (stream->list (stream-take s n)))

; Recursivitate

;---stivă/coadă
; rotate fără take/drop
(define (rotate-left-q L n)
  (if (zero? n)
      L
      (rotate-left-q (append (cdr L) (list (car L)))
                     (sub1 n))))
(define (rotate-left-s L n)
  (define (rotate L) (append (cdr L) (list (car L))))
  (if (zero? n)
      L
      (rotate (rotate-left-s L (sub1 n)))))
      
;(rotate-left-q (range 20) 4)
;(rotate-left-s (range 20) 4)


; Funcționale

;---produs cartezian
;pattern:
; map în map + aplatizare
(define (cartesian-product A B)
  (apply append
         (map (λ (a) (map (curry cons a) B))
              A)))
;(cartesian-product '(1 2 3) '(a b c d))

;---prelucrare paralelă
;pattern:
; map f L1 .. Ln
(define (hamming-distance A B)
  (length
   (filter (compose not identity)
           (map equal? A B))))
;(hamming-distance '(G A T T A C A) '(G C T A C G A))

(define (multiply M V)
  (map (λ (row) (apply + (map * row V)))
       M))
;(define M '((1 2 3) 
;            (4 5 6)))
;(define V '(1 0 2))
;(multiply M V)

;---prelucrare paralelă cu padding
;v. (make-list n val)
(define (add-poly P1 P2)
  (define l1 (length P1))
  (define l2 (length P2))
  (define l  (min l1 l2))
  (map +
       (append P1 (make-list (- l2 l) 0))
       (append P2 (make-list (- l1 l) 0))))
       
;(add-poly '(1 0 2) '(0 1 1 1 2))
    
;---prelucrare alternantă
;cu map
;pattern:
; - folosim range pt a produce liste de aceeași lungime
;   și împerechem cu map
; - prelucrăm
; - desperechem cu map
(define (odd-pos L)
  (map car
       (filter (compose odd? cdr)
               (map cons L (range (length L))))))
;(odd-pos '(10 9 1 5 2 6 7 0))

;cu fold
;pattern
; - "tupling" pe acc
;   - res +
;   - toate informațiile necesare efectuării următoarei iterații
; - "untupling"
(define (alternate L f1 f2)
  (define (switch f)
    (if (equal? f f1) f2 f1))
  (reverse
   (car
    (foldl (λ (x acc)
             (match acc
               ((cons res f)
                (cons (cons (f x) res) (switch f)))))
           (cons '() f1)
           L))))
;(alternate '(1 2 3 4 5 6 7) add1 sub1)         

;---prelucrare selectivă
(define (two-sums L)
  (let ((outer (filter (compose not list?) L))
        (inner (apply append (filter list? L))))
    (cons (apply + outer)
          (apply + inner))))
;(two-sums '((1 2) 10 20 (3 4 5) 30 (6) (7) 40 50))
  
; Legări

;---ciclări imbricate
;pattern:
;(define (func L)
;  (let outer-loop ((L L) (res '()))
;    (if (null? L)
;        (reverse res)
;        (let inner-loop (..sublist.. ..current-state..))
;          ... 
;          (outer-loop ..sublist.. (f new-val res))))))

(define (encode L)
  (let outer ((L L) (res '()))
    (if (null? L)
        (reverse res)
        (let inner ((rest (cdr L)) (count 1))
          (cond
            ((null? rest) (outer rest (cons (list (car L) count) res)))
            ((equal? (car L) (car rest)) (inner (cdr rest) (add1 count)))
            (else (outer rest (cons (list (car L) count) res))))))))
;(encode '(a a a b c c a a d))

; Fluxuri

;---iterate: x, f(x), f(f(x)) ...
;'(1) '(1 2 1) '(1 2 3 2 1) '(1 2 3 4 3 2 1) ...
;explicit
;(let loop ((seed ..))
; (stream-cons seed (loop (f seed))))
(define hills
  (let loop ((seed '(1)))
    (stream-cons
     seed
     (loop (append '(1) (map add1 seed) '(1))))))
  
;implicit
;(stream-cons
;   seed
;   (stream-map f
;               fluxul-însuși))
(define hills-i
  (stream-cons
   '(1)
   (stream-map (λ (seed) (append '(1) (map add1 seed) '(1)))
               hills-i)))
;(show hills-i 5)

;'(1) '(1 1) '(1 2 1) '(1 3 3 1) ...
(define pascal-triangle
  (stream-cons
   '(1)
   (stream-map (λ (L) (map + (cons 0 L) (append L '(0))))
               pascal-triangle)))
;(show pascal-triangle 10)

;'(1) '(1 1) '(1 1) '(1 1 1) '(1 1 1) '(1 1 1 1) '(1 1 1 1) ...
;pattern: x, y, f(x), f(y), f(f(x)), f(f(y)) ...
(define one-lists
  (stream-cons
   '(1)
   (stream-cons
    '(1 1)
    (stream-map (curry cons 1) one-lists))))
;(show one-lists 10)

(define (dec-odd-positions L)
  (define (repeat a b) (stream-cons a (repeat b a)))
  (define repeat0-1 (show (repeat 0 -1) (length L)))
  (let loop ((seed L))
    (stream-cons
     seed
     (loop (map + seed repeat0-1)))))
;(show (dec-odd-positions '(1 1 1 1 1)) 5)               

;---combinarea fluxului însuși cu alt flux
(define (partial-unions s)
  (define (union A B)
    (append A (filter (λ (x) (not (member x A))) B)))
  (letrec ((unions
            (stream-cons
             '()
             (stream-zip-with union unions s))))
    unions))
(define naturals-lists
  (stream-map list naturals))
;(show (partial-unions naturals-lists) 10)