#lang racket
(require (lib "trace.ss"))

; ------------------Funcții ca valori evaluate la ele însele------------------
(define a +)
;a
;(a 2 3 5)

;null?

(define fs (list +
                 (λ (x y) (- x y y))
                 ((λ (x) (λ (y) (- x y y))) 5) ; (λ (y) (- 5 y y))
                 5))
;fs
;((cadr fs) 20 8)
;((caddr fs) 1)


; ------------------Funcții ca valori de retur------------------
(define (f x)
  (if (< x 100) + -))

;(f 25)
;((f 120) 16 4)

(define (g x)
  (λ (y)           
    (cons x y)))   

;(g 2)   ; x=2 retur=(λ (y) (cons 2 y))
;( (g 2) '(5 2) ) ; x=2 y='(5 2) retur='(2 5 2)


; ---------------------- Funcții curry / uncurry
(define (plus-curry x)
  (λ (y)          
    (+ x y )))    

(define (plus-uncurry x y)
  (+ x y))
; identic cu (define plus-uncurry +)

; Cum adun 2 + 4?
;(plus-uncurry 2 4)
;((plus-curry 2) 4)

; Ce se întâmplă la aplicare parțială?
;(plus-curry 2) 
;(plus-uncurry 2) 

; Cum obțin (cu efort minim) inc din plus-curry?
;(define (inc x) ((plus-curry 1) x)) -care se poate simplifica:
;(define inc (plus-curry 1))
;(map inc '(1 3 5 6))

; Dar din plus-uncurry?
;(define (inc x) (plus-uncurry 1 x))

; Ex: variante de a incrementa toate valorile unei liste
(define L '(1 2 3 4 5))
; cu funcția de bibliotecă
;(map add1 L)
; cu plus definit de noi
;(map (plus-curry 1) L)
; cu funcții anonime
;(map (λ (x) (+ x 1)) L)
; cu funcția existentă 'curry'
;(map (curry + 1) L)


; ------------------Reutilizare de cod------------------
; Ex: sortare prin inserție
(define ((ins-sort cmp) L)
  (if (null? L)
      L
      (insert cmp (car L) ((ins-sort cmp) (cdr L)))))

(define (insert cmp x L)
  (if (or (null? L) (cmp x (car L)))
      (cons x L)
      (cons (car L) (insert cmp x (cdr L)))))


; Ex: sortare descrescătoare
(define sort< (ins-sort <))
(define sort> (ins-sort >))
;(sort< '(4 1 2 5 3 2 4 1 7 9 8 6 5))
;(sort> '(4 1 2 5 3 2 4 1 7 9 8 6 5))
; Ex: sortare mod 3
(define sort-mod3 (ins-sort (λ (x y) (< (modulo x 3) (modulo y 3)))))
;(sort-mod3 '(4 1 2 5 3 2 4 1 7 9 8 6 5))

; ------------------Continuation passing style-------------------
(define (fact n k)
  (if (zero? n)
      (k 1)
      (fact (- n 1) (compose k (curry * n)))))
;(time (begin (fact 100000 identity) 'done))

(define (fact-st n)
  (if (zero? n)
      1
      (* n (fact-st (- n 1)))))
;(time (begin (fact-st 100000) 'done))

; Ex: transform-evens folosind CPS
; toate x pare devin f(x), toate x impare rămân x
; Obs: recursivitate pe coadă, folosind cons,
;      fără obținerea listei în ordine inversă
(define (transform-evens-cps f L k)
  (cond
    ((null? L) (k '()))
    ((even? (car L))
     (transform-evens-cps f (cdr L) (compose k (curry cons (f (car L))))))
    (else
     (transform-evens-cps f (cdr L) (compose k (curry cons (car L)))))))
;(transform-evens-cps add1 '(1 2 3 4 5 6) identity)

; Ex: funcția g de data trecută
;(define (g L result)
;  (cond ((null? L)        result)
;        ((list? (car L))  (g (cdr L) (append (g (car L) '()) result))) ; evaluare aplicativă
;        (else             (g (cdr L) (cons (car L) result)))))
(define (g-cps L result k)
  (cond ((null? L) (k result))
        ((list? (car L))
         (g-cps (car L)
                '()
                (λ (res-car)
                  (g-cps (cdr L)
                         (append res-car result)
                         k))))
        (else (g-cps (cdr L) (cons (car L) result) k))))

  
;(g-cps '(1 (2 3) (4 (5 6))) '() identity)

; Ex: append multiplu în complexitate liniară
(define (app A B)
  (if (null? A)
      (begin (newline) B)
      (begin (display (car A)) (cons (car A) (app (cdr A) B)))))
(define (concat Ls k)
  (if (null? Ls)
      (k '())
      (concat (cdr Ls) (compose k (curry app (car Ls))))))

(concat '((1 2 3) (a b) (c 4 d 5 e) (6)) identity)

; Alte exemple interesante:
; Mergesort cu CPS
; Nu este mai eficient, dar este recursiv pe coadă
(define (merge-cps L1 L2 k)
  (cond
    ((null? L1) (k L2))
    ((null? L2) (k L1))
    ((< (car L1) (car L2))
     (merge-cps (cdr L1) L2 (compose k (curry cons (car L1)))))
    (else
     (merge-cps L1 (cdr L2) (compose k (curry cons (car L2)))))))

(define (mergesort-cps L k)
  (define chunk (quotient (length L) 2))
  (if (or (null? L) (null? (cdr L)))
      (k L)
      (mergesort-cps
       (take L chunk)
       (lambda (sorted-left)
         (mergesort-cps
          (drop L chunk)
          (lambda (sorted-right)
            (merge-cps sorted-left sorted-right k)))))))

;(trace mergesort-cps)
;(mergesort-cps '(3 4 8 2 1 9 1 7 3 6) identity)