;---------------------------------------------------------------

; 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.

### Promote Your Functions!

Subscribe to:
Post Comments (Atom)

## No comments:

## Post a Comment