Folding and Such

[Jeremy Dunn]

In our code snippets is a little function for doing alternating addition and subtraction that enables you to write an expression like a+b-c+d.. as

(+- a b c d ...)

which is just a shorthand for (+ (- (+ a b) c) d). One immediately thinks about generalizing this for any two functions A and B to get (A (B (A a b) c) d). But wouldn't it be even more general to allow any number of functions so that we could have expressions like (B (A (C (B (A a b) c) d) e) f)? I then considered that there are really four cases that we might have that are variations of whether we reverse the order of arguments or of the direction we apply the operators in. They are

(B (A (C (B (A a b) d) e) f) g)
(B f (A e (C d (B c (A a b)))))
(A (B (C (A (B a b) d) e) f) g)
(A f (B e (C d (A c (B a b)))))

So I came up with a FOLD function that does all this. One first lists the operators, a comma and then the arguments. The first function is quoted if you want to reverse the arguments and the second function is quoted if you want to reverse the operator order. For instance, the above four cases would be written as

(fold A B C , a b c d e f g)
(fold 'A B C , a b c d e f g)
(fold A 'B C , a b c d e f g)
(fold 'A 'B C , a b c d e f g)

Here is the code for doing this

Code: Select all

(define-macro (fold)
 (local
  (ind funcs funcL vars varL start flg1 flg2 f)
  (setq ind   (find , (map eval (args)))  ;find where the colon is
        funcs (0 ind (args))      ;get a list of the functions 
        vars  ((inc ind)(args))   ;get a list of the arguments to process 
        funcL (length funcs)      ;get the number of functions
        varL  (length vars)       ;get the number of variables
  )
  ;..if the argument is a list then set vars to the list and process that
  (if (list? (args -1))
      (setq vars (args -1))
  )
  (setq flg1 (symbol? (eval (funcs 0))))  ;set flag to reverse argument order
  (setq flg2 (symbol? (eval (funcs 1))))  ;set flag to reverse operator order
  (when (>= varL 3) ;we must have at least 3 arguments to process
    (setq start (eval (list (eval (funcs 0))
                            (vars 0)
                            (vars 1))))  ;do the first calculation
    ;loop thru the rest of the arguments
    (dolist (a (2 vars))
      (setq f     (funcs (dec (% (if flg2 (- varL $idx) $idx) funcL)))
            start (eval (push (eval f) (if flg1 (list a start)(list start a))))
      ))
    start
  )))

So now we could write (+- a b c d e) or the more general (fold add sub , a b c d e). Another case of repetitive operations are continued fractions. For instance, the simplest continued fraction is that for the golden ratio (1.618) which can be represented now as (fold 'add 'div , 1 1 1 1 1 1 1). Of course you need a lot of ones to converge on phi. You must remember that all functions must be able to take a minimum of two arguments.

I believe this function is sufficiently general to be a handy one in the toolbox. A caveat: I wanted this function to be able to take a list of arguments like
(fold 'add 'div , (list 1 1 1 1 1)) as well but my section of code for doing that doesn't seem to work. Can anyone tell me what I did wrong? I have a devil of a time knowing when to EVAL and when not to to get things to process correctly :-)

[cormullion]

Wow - tricky stuff there...!

I'm not too sure I know what you're doing here, but perhaps this:

Code: Select all

(when (list? (args -1)) 
      (setq vars (eval (args -1)))
      (setq varL (length vars))
  ) 

instead of your if makes it better?