;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Priklady funkcionalov pracujucich nad symbolickym vyrazom
;;; Autor: Ivan Kapustik
;;; Praca nad lubovolnym s-vyrazom (atom, viacurovnovy zoznam, bodka-dvojica) je domenou Lispu.
;;; Vo vacsine ostatnych jazykov sa s takouto strukturou lubovolneho typu nestretnete. Ale ked
;;; je k dispozicii, je vhodne ju vyuzit.
;;; Funkcionaly tu uz nie su take vyhranene, ako pre linearny zoznam, lebo poziadavky na
;;; spracovanie s-vyrazu sa muozu lisit nielen vo forme vysledku ale aj vo forme prechadzania
;;; s-vyrazu. Stale tu najdeme mapovanie a redukciu, ale uz su nezaujimave filtre. Pribudli
;;; funkcionalne predikaty.
;;; Pretoze pracuju nad komplexnou strukturou, vo svojom mene zahrnaju skratku slova structural,
;;; cim sa hned odlisia od standardnych funkcionalov pre linearny zoznam.
;;; Je este duolezite spomenut, ze vsetky tieto vseobecne funkcionaly volaju dodanu funkciu len
;;; na atomy, lebo nie je mozne najst iny vhodny vseobecny test jej na aktivovanie.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Mapovanie musi zachovat strukturu, preto kazde nil ako koniec zoznamu vrati na vystup.
;;; Structural Map
;; s-map :: function x {a} -> {a}
;; function :: a -> a
(defun s-map (f sv)
  (cond ((null sv) nil)
	((atom sv) (funcall f sv))
	(t (cons (s-map f (first sv))(s-map f (rest sv)))) ))

;(s-map #'(lambda (n)(+ 1 n)) '(5 (4 (3 2) 1) 6))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Predikaty tiez spacuvaju nil po svojom.
;;; Structural Functional Predicate, vrati "nil" ak aspon jedno volanie "f" vrati "nil", inak "t"
;; sfp-all :: f x {a} -> bool
(defun sfp-all (f sv)
  (cond ((null sv) t)
	((atom sv) (funcall f sv))
	(t (and (sfp-all f (first sv))(sfp-all f (rest sv)))) ))

;(sfp-all #'(lambda (n)(<= 1 n)) '(5 (4 (3 2) 1) 6))
;(sfp-all #'(lambda (n)(<= 2 n)) '(5 (4 (3 2) 1) 6))

;;; Structural Functional Predicate, vrati "t" ak aspon jedno volanie "f" vrati "t", inak "nil"
;; sfp-some :: f x {a} -> bool
(defun sfp-some (f sv)
  (cond ((null sv) nil)
	((atom sv) (funcall f sv))
	(t (or (sfp-some f (first sv))(sfp-some f (rest sv)))) ))

;(sfp-some #'(lambda (n)(>= 1 n)) '(5 (4 (3 2) 1) 6))
;(sfp-some #'(lambda (n)(> 1 n)) '(5 (4 (3 2) 1) 6))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Na redukciu su znovu k dispozicii funkcionaly fold na prechadzanie z lava do prava aj opacne.
;;; Na sledovanie, ako prechadzaju vstupnu strukturu do hlbky, je znovu vhodne pouzit (trace ...).
;;; Vsimnite si, ze akumulator nemusi byt atom.
;;; s-fold standardne spracovava koniec zoznamu - nil po svojom.
;;; Structural Fold
;; s-foldl :: function x {a} x {a} -> {a}
;; function :: a x {a} -> {a}
(defun s-foldl (f acc sv)
  (cond ((null sv) acc)
	((atom sv) (funcall f sv acc))
	(t (s-foldl f (s-foldl f acc (first sv)) (rest sv))) ))

;(trace s-foldl)
;(s-foldl #'cons nil '(5 (4 (3 2) 1) 6))
;(s-foldl #'+ 0 '(5 (4 (3 2) 1) 6))
;(s-foldl #'* 1 '(5 (4 (3 2) 1) 6))
;(s-foldl #'(lambda (n acc)(cond ((evenp n) acc)(t (+ n acc)))) 0 '(5 (4 (3 2) 1) 6))
;(untrace s-foldl)

;; s-foldr :: function x {a} x {a} -> {a}
;; function :: a x {a} -> {a}
(defun s-foldr (f acc sv)
  (cond ((null sv) acc)
	((atom sv) (funcall f sv acc))
	(t (s-foldr f (s-foldr f acc (rest sv)) (first sv))) ))

;(trace s-foldr)
;(s-foldr #'cons nil '(5 (4 (3 2) 1) 6))
;(s-foldr #'+ 0 '(5 (4 (3 2) 1) 6))
;(s-foldr #'* 1 '(5 (4 (3 2) 1) 6))
;(s-foldr #'(lambda (n acc)(cond ((oddp n) acc)(t (+ n acc)))) 0 '(5 (4 (3 2) 1) 6))
;(untrace s-foldr)

;;; as-fold necha spracovat koniec zoznamu - nil dodanej funkcii!
;;; Altered Structural Fold
;; as-foldl :: function x {a} x {a} -> {a}
;; function :: a x {a} -> {a}
(defun as-foldl (f acc sv)
  (cond ((atom sv) (funcall f sv acc))
	(t (as-foldl f (as-foldl f acc (first sv)) (rest sv))) ))

;(as-foldl #'(lambda (n acc)(cond ((null n) acc)(t (+ n acc)))) 0 '(5 (4 (3 2) 1) 6))

;; as-foldr :: function x {a} x {a} -> {a}
;; function :: a x {a} -> {a}
(defun as-foldr (f acc sv)
  (cond ((atom sv) (funcall f sv acc))
	(t (as-foldr f (as-foldr f acc (rest sv)) (first sv))) ))

;(as-foldr #'cons nil '(5 (4 (3 2) 1) 6)) ;; vrati "oznackovany" zoznam
;(as-foldr #'(lambda (n acc)(cond ((null n) acc)(t (cons n acc)))) nil '(5 (4 (3 2) 1) 6))