Promote Your Functions!

;---------------------------------------------------------------
; As usually, few definitions I frequently use.

(set 'macro (lambda-macro()(append (lambda-macro) (args))))
(set 'function (macro() (append (lambda) (args))))

(set '-line (dup "-" 64))
(set '--- (function()(println -line)))

(set '§§ (macro(§-argument)
               (list '-> §-argument (eval §-argument))))
(set '§ (macro() (doargs(§§-argument)
                 (println (eval (list '§§ §§-argument))))))

;---------------------------------------------------------------
; I'll try to define some tools for defining of the very simple
; class of the higher order functions, based on the "ordinary"
; functions. For example, for a given function add, I want to
; define addf, which does not sum the numbers, but functions.
;
; But, what does it mean? What is the sum of the functions,
; say, sin and cos? The simplest and in mathematics most
; frequently used definition is that the result is the function
; sin + cos such that
;
;         (sin + cos)(x) = sin x + cos x
;
; In Newlisp terms, it is
;
;         ((addf 'sin 'cos) x) = (add (sin x) (cos x))

; Furthermore, after I learn how to define addf manually, I want
; to develop tool, i.e function that does the same, so I can simply
; write

;         (set 'addf (increase-order 'add))

; I have to write such programs very gradually, starting with
; simple examples, and slowly generalizing. Otherwise, I find
; myself guessing about errors in the code I only partially understand.


; So, let's start with expression (add (sin 3)(cos 3)):


(§ (add (sin 3) (cos 3)))


; RESULT: (-> (add (sin 3) (cos 3)) -0.8488724885)

; Now, an easy part. How function that takes 3 as an argument and
; returns -0.84888... looks like? Obviously,
;
;               (lambda(x)(add (sin x) (cos x))).
;
; Or, using previously defined "function:"


(§ ((function(x)(add (sin x) (cos x))) 3))


; RESULT: (-> ((lambda (x) (add (sin x) (cos x))) 3) -0.8488724885)
; As expected, it works.

;---------------------------------------------------------------
; Now, look at the list (add (sin x) (cos x) ....). It appears
; that part can be generated by appending of the list (add) and list
; ((sin x) (cos x) ...). This second can be the result of some
; function that accepts two arguments: list of the function names,
; (or more generally, s-expressions that evaluate to functions) and
; of an argument on which functions will be applied.
; Let's call that function pamq, because it is somehow
; dual to the function map. So, I want

;         (pamq (list 'sin 'cos) 'x) => ((sin x) (cos x))

; it is not complete dual. Because in Newlisp, (map 'sin (list 'x 'y))
; does not evaluate to ((sin x) (sin y)); instead, map tries to apply
; sin on x and y, and if these have values, say 1 and 2 respectively,
; it evaluates to

;                 (0.8414709848 0.9092974268),

(---)
(set 'pamq (function(L a)
             (map (function(li)(list li a)) L)))
             
; Does it work?

(§ (pamq (list 'sin 'cos) 'x))

; It does: (-> (pamq (list 'sin 'cos) 'x) ((sin x) (cos x)))
; However, if I'm already here, I'll also write real pam, to be dual to
; map; and mapq to be dual to pamq, I'll put these functions in
; my library, just in the case I'll need them
; in future.

(---)
(set 'pam (function(L a)
            (map (function(fi)(eval (list fi a))) L)))
            

(set 'mapq (function(f L)
               (map (function(li)(list f li)) L)))
               
(§ (pam (list 'sin 'cos) 3)) ;(-> ... (0.1411200081 -0.9899924966))
(§ (mapq 'sin (list 'x 'y))) ;(-> ... ((sin x) (sin y)))


; They work. Back to the task of writing function addf such that
; (addf f1 ... fn) evaluates to (lambda(x)(add (f1 x)(f2 x)...(fn x))).

(set 'addf (function()
               (append '(lambda(x))
                       (list (append '(add) (pamq (args) 'x))))))

; Does it work?

(---)
(§ (addf 'sin 'cos)) ;(-> ... (lambda (x) (add (sin x) (cos x))))
(§ ((addf 'sin 'cos) 3)) ; (-> ... -0.8488724885)

; It does. The definition of 'addf is rather complicated. It is
; complicated because I must leave the expression (args) unquoted.

; Now, I'll make one generalization further. Sumation of the functions
; have sense for functions that accept more than one argument.
; For example, * and / accept two arguments and they can be added too.

; So, I want function that takes functions f1, f2 ... etc as argument
; and evaluates to

;     (lambda()(add (apply f1 (args)) .... (apply fn (args))))

; suddenly, my pretty function pamq is rather useless, and the best thing
; I can do is to write similar, but special function for this purpose:

(set 'pamq-special (function (L)
                      (map (function(li)(list 'apply li '(args))) L)))

(---)
(§ (pamq-special (list 'sin 'cos)))

; It works: (-> ... ((apply sin (args)) (apply cos (args))))

(set 'addf (function()
               (append '(lambda())
                       (list (append '(add) (pamq-special (args)))))))

(§ (addf 'sin 'cos)) ;(-> ... (lambda () (add (apply sin (args))
                      ;                        (apply cos (args)))))
(§ ((addf 'sin 'cos) 3)) ; (-> ... -0.8488724885)

; It's even better; pamq-special and addf use fewer symbols.
; Another test: the function +*/ is defined as sum of  two
; functions of two arguments, * and /. The result should be  
; (+*/ 4 2) = (+ (* 4 2) (/4 2)) = 10.

(---)
(set '+*/ (addf '* '/))
(§ (+*/ 4 2))

; OK, it works. Now, I'm ready for the last and most productive
; generalization - instead of using addf defined "by hand", I'll
; define function "increase-order" that accepts "ordinary" function as
; argument and returns it higher-order version.
;
; For example, "increase-order" should be able to take add as argument,
; and return value of already defined addf,
;
;    (function()
;       (append '(lambda())
;               (list (append '(add) (pamq-special (args)))))))


(set 'increase-order
     (function()
         (eval (list 'function '()
                  (list 'append ''(lambda())
                        (list 'list (list 'append (list 'quote (args))
                                                 '(pamq-special (args)))))))))


; Again, it is rather complicated. Not long, but complicated.
; There are lot of "lists" and "eval."; Why they are necessary?
; Because I had to ensure that the first occurence of (args) is free,
; i.e. it is not quoted, and Newlisp has no "quasiquote" yet.

; But it is relatively pretty function; it does not use any local
; variable. One can complain that it requires my user-made
; functions "function" and "pamq-special", but they can be eliminated.


(---)
(§ (increase-order 'add))

; (-> ... (lambda ()
;            (append '(lambda ())
;                     (list (append (quote (add))
;                                   (pamq-special (args)))))) )

; Hm ... it could work

(set 'addf (increase-order 'add))
(set '+f (increase-order '+))

(set 'sin+cos (addf 'sin 'cos))
(set '+*/ (+f '* '/))

(§ (sin+cos 3)) ; (-> (sin+cos 3) -0.8488724885)
(§ (+*/ 4 2)) ; (-> (+*/ 4 2) 10)

; Yap, it does work. But, what is the advantage of defining such
; functions? Shortening of the programs, clarity of the conceptions
; and possibly, easier detection of errors.


;---------------------------------------------------------------
; Example: increase-order is used for definition of reversef function
; that doesn't reverse the lists, but generates the function that
; reverses the lists, beside doing something else.

(---)
(set 'reversef (increase-order 'reverse))
(set 'reversed-map (reversef 'map)) ;

(§ reversed-map)
(§ (reversed-map 'sqrt (list 1 4 9 16)))

; (-> reversed-map (lambda () (reverse (apply map (args)))))
; (-> (reversed-map 'sqrt (list 1 4 9 16)) (4 3 2 1))

; Of course, the same result can be achieved without reversef,
; just it will require seven instead of two tokens and 16 instead of 5
; if we count apostroph and parentheses as well.