Fun with MAP

[Jeremy Dunn]

Tired of nested MAP statements like



(map sqrt (map sin (map add L1 L2)))?



I always wanted to write something like this as



(map sqrt sin add L1 L2)



Now you can do it with the MMAP function here

Code Select Expand


(define-macro (mmap)
  (setq L1    (length (filter list? (args)))
        L2    (length (args))
        i     (- L2 L1 1)
        start (apply map (map eval (i (args))))
        funcs (reverse (0 i (args))))
  (dolist (f funcs)
     (setq start (map f start)))
  start)


Is there any reason that the standard MAP function couldn't be enhanced this way? In fact it occurs to me that one often has a final APPLY statement tacked on the outside. Perhaps this could be further enhanced to tack on a final APPLY statement by quoting the first function name. So if you had



(apply + (map sin (map abs L)))



you could write



(amap '+ sin abs L)



We could then subsume both statements into one even adding an optional argument on the tail end for the APPLY integer.

[Lutz]

Yes, what you are describing is a frequently used pattern. There are several things around the map function which could be done, i.e.. mappend, suggested by Rickyboy goes into a similar direction. I am collecting all of these suggestions and I am thinking about it.



Lutz

[Jeremy Dunn]

I just can't stop having fun with this, I am probably reinventing the lightbulb but consider this: Suppose we have an expression like



(* (+ a b)(+ c d)(+ e f))



In this case it would be nice to collect all of the variables together and use the + symbol just once. Let us say like this



(apply * (vmap 2 + a b c d e f))



VMAP maps a function onto groups of variables and returns a list of the results that you can then feed into something else. In our example there is an integer 2 that tells the function what size grouping to use to pair off the variables. We can add the further proviso that if no integer is supplied then the integer defaults to 2 so that we could then write



(apply * (vmap + a b c d e f))



Pretty neat huh? Here is some code to do this if anyone wants to play with it.

Code Select Expand


;; Helper function. Takes a list and returns the list broken into segments
;; of length n
(define (pairs lst n , nlist)
 (dotimes (z (/ (length lst) n))
   (setq nlist (cons ((* n z) n lst) nlist))
 )
 (rest (reverse nlist)))

;; Now the fun stuff
(define-macro (vmap)
 (if (integer? (eval (setq z (args 0))))
   (setq op  (args 1)
         num (eval z)
         arg (2 (args)))
   (setq op  z
         num 2
         arg (rest (args))))
 (map (fn (x)(apply op x))
  (pairs (map eval arg) num)))


[Lutz]

Nice, here is an improvement for the pairs helper function:

Code Select Expand


(define (pairs lst n)
  (array-list (array (/ (length lst) n) n lst)))


it is much faster on bigger lists



Lutz



ps: corrected after Sammo's post, thanks

[Sammo]

Hi Lutz,



Should 'pairs' be as follows:

Code Select Expand


(define (pairs lst n)
  (array-list (array (/ (length lst) n) n lst)))
in which I replaced '2' with 'n'?

[Jeremy Dunn]

I'm a busy boy tonight. Consider the case



(* (sin x)(cos x)(tan x))



where we have several functions mapped to a single argument or group of arguments. FMAP allows you to write this as



(apply * (fmap sin cos tan x))



Here's the code

Code Select Expand


(define-macro (fmap)
  (setq funcs (filter symbol? (args))
        L     (length funcs)
        arg   (dup (map eval (L (args))) L))
  (map (fn (x y)(apply x y)) funcs arg))


And finally we have a function to handle nested statements i.e.

(fn3 (fn2 (fn1 x y ...))) can be written as

(nest fn3 fn2 fn1 x y ...).



And the code

Code Select Expand


(define-macro (nest)
  (setq funcs (reverse (filter symbol? (args)))
        L     (length funcs)
        op    (first funcs)
        funcs (rest funcs)
        arg   (map eval (L (args)))
        start (apply op arg)
  )
  (dolist (f funcs)
    (setq start (apply f (list start)))
  )
  start
)


[eddier]

You might want to implement filter-map as well. There are a bunch of nice functions in the SRFI libraries like append-map and one that I was using quite often when collecting data for calculations. Note that I just copied this documentation from the DrScheme help desk.



filter-map f clist1 clist2 ... -> list



Like map, but only true values are saved.

(filter-map (lambda (x) (and (number? x) (* x x))) '(a 1 b 3 c 7))

    => (1 9 49)



Note that filter-map is both more efficient and flexible than (map f1 (filter f2 data)). More efficient since it only makes one pass over the data and more flexible since it can be applied to multiple lists. Both append-map and filter-map work if lists are different lengths and are circular lists (although one has to be finite).



eddier

[Jeremy Dunn]

It occurs to me that we need a couple of functions devoted to testing boolean functions on the items in a list. Here are what I use

Code Select Expand


(define (andmap? bool lst)(apply and (map bool lst)))
(define (ormap? bool lst)(apply or (map bool lst)))

So now if I wanted to determine if every item in a list was a string I could write



(andmap? string? lst)



And if I wanted to determine if at least one item in the list was a string I would write



(ormap? string? lst)

[Fanda]

I think about mapping as "parallel" or "serial" mapping.



SERIAL MAP (MMAP) - chain-like mapping

(smap (f1 f2 f3) x y) => (map f1 (map f2 (map f3 x y)))



PARALLEL MAP (FMAP) - all functions mapped at once

(pmap (f1 f2 f3) x y) => (list (f1 x y) (f2 x y) (f3 x y))



Implementation:

Code Select Expand

;; (smap (f1 f2 f3) x y ...) => (map f1 (map f2 (map f3 x y ...)))
;;
(define (smap fns)
  (let (values (args))
    (dolist (f (reverse fns))
      (if (!= $idx 0)
        (set 'values (list values)))
      ;(println (append '(map) (list f) values))
      (set 'values (apply map (append (list f) values))))
    values))

; > (smap '((fn (x) (sub x 1.5)) sqrt add) '(1 2) '(3 4))
; (map add (1 2) (3 4))
; (map sqrt (4 6))
; (map (lambda (x) (sub x 1.5)) (2 2.449489743))
; (0.5 0.9494897428)


Code Select Expand

;; (pmap (f1 f2 f3) x y ...) => (list (f1 x y ...) (f2 x y ...) (f3 x y ...))
;;
(define (pmap fns)
  (let (values (args))
    (map (fn (f) (apply f values)) fns)))

; > (pmap '(+ - * /) 8 4)
; (12 4 32 2)

; > (pmap '(+ - * /) 8 4 2)
; (14 2 64 1)


[Fanda]

After mapping we sometimes need to call the function:

> (join (map string '(1 2 3)))

"123"



To do multiple things, we can define function 'pass' (more versions listed):

Code Select Expand

;; (pass-older (f1 'f2 f3) x y ...) => (map f1 (f2 (map f3 x y ...)))
;;
(define (pass-older fns)
  (let (values (args))
    (dolist (f (reverse fns))
      (if (!= $idx 0)
        (set 'values (list values)))
      (if (quote? f)
        (set 'values (apply (eval f) values))
        (set 'values (apply map (append (list f) values)))))
    values))


> (pass-older '('join string) '(1 2 3))

"123"



We could also include 'pmap' info 'pass' using (f1 f2):

Code Select Expand

;; (pass (f1 'f2 (f3 f4) f5) x y) => (map f1 (f2 (f3 (map f5 x y)) (f4 (map f5 x y))))
;;
(define (pass-older2 fns)
  (let (values (args))
    (dolist (f (reverse fns))
      (if (!= $idx 0)
        (set 'values (list values)))
      (if
        (and (list? f) (not (lambda? f)))
          (set 'values (map (fn (ff) (apply ff values)) f))
        (quote? f)
          (set 'values (apply (eval f) values))
        (set 'values (apply map (append (list f) values)))))
    values))


> (pass-older2 '((+ -)) 8 4)

(12 4)

> (pass-older2 '(string (+ -)) 8 4)

("12" "4")



And final version as macro, added 'apply' and syntax change for quoting:



(f x) == (pass (f) x)

(map f lst) == (pass ('f) lst)

(apply f lst) == (pass (''f) lst)

(list (f1 x) (f2 x)) == (pass ((f1 f2)) x)

Code Select Expand

;; pass multiple functions on data
;;
;; (f x) == (pass (f) x)
;; (map f lst) == (pass ('f) lst)
;; (apply f lst) == (pass (''f) lst)
;; (list (f1 x) (f2 x)) == (pass ((f1 f2)) x)
;;
(define-macro (pass _fns)
  (let (_values (map eval (args)))
    (dolist (_f (reverse _fns))
      (if (!= $idx 0)
        (set '_values (list _values)))
      (if
        (and (list? _f) (not (lambda? _f)))
          (set '_values (map (fn (_ff) (apply _ff _values)) _f))
        (quote? _f)
          (if (quote? (eval _f))
            (set '_values (apply (eval (eval _f)) (apply append _values)))
            (set '_values (apply map (append (list (eval _f)) _values))))
        (set '_values (apply _f _values))))
    _values))


Now, many different variations can be generated:

Code Select Expand

> (set 'pi (mul 2 (asin 1)))
3.141592654
> (tan (cos (sin (div pi 2))))
0.5998406268
> (pass (tan cos sin) (div pi 2))
0.5998406268


Code Select Expand

> (list (sin 0) (cos 0))
(0 1)
> (pass ((sin cos)) 0)
(0 1)


Code Select Expand

> (set 'ind '(9 2 0 12 1 4 10 8 6 13 11 5 7 3 14))
(9 2 0 12 1 4 10 8 6 13 11 5 7 3 14)
> (set 'str "swnueI iPnfS L!")
"swnueI iPnfS L!"
> (join (map last (sort (map list ind (explode str)))))
"newLISP is fun!"
> (pass (join 'last sort 'list) ind (explode str))
"newLISP is fun!"


Code Select Expand

;; c^2 = a^2 + b^2
;; c = sqrt(a^2 + b^2)
> (sqrt (apply add (map pow '(3 4))))
5
> (pass (sqrt ''add 'pow) '(3 4))
5


Fanda

[Jeremy Dunn]

Good work Fanda. I like I like! This I think is a perfect example of the mental attitude of the average LISPer, we are always looking for those zen perfect abstractions that reduce the universe to a single word.

[rickyboy]

Oops, some of this "functional ground" has already been covered by John Small (with improvements by Lutz) over two years ago at http://www.alh.net/newlisp/phpbb/viewtopic.php?t=427">//http://www.alh.net/newlisp/phpbb/viewtopic.php?t=427.



For instance, Jeremy's 'mmap' is usually accomplished with a composer in FP circles (cf. John's 'compose' macro).  The expression



(map f1 (map f2 (map f3 x y)))



being equivalent to a map of the composition of f1, f2 and f3 and can thus be written as



(map (compose f1 f2 f3) x y).



The following is an updated composer definition (a function this time, not a macro).

Code Select Expand

(define (foldl f init xs)
  ;; (foldl f init xs) => (f (f (f init x1) x2) ... xN)
  (apply f (cons init xs) 2))

(define (compose)
  (letex ((_rfns (reverse (args))))
    (lambda ()
      (let ((rfns (quote _rfns))
            (init (args)))
        (if (empty? rfns)
            init
          (foldl (lambda (x f) (f x))
                 (apply (first rfns) init)
                 rfns))))))

Secondly, I liked the function 'pairs' offered by Jeremy (and improved by Lutz & Sammo), except that I might rename it to 'part' (for "partition") and reverse the parameters.

Code Select Expand

(define (part n lst) (array-list (array (/ (length lst) n) n lst)))

That way I can define the function 'pairs' by currying on 'part'.

Code Select Expand

(define pairs (curry part 2))

> (pairs '(1 2 3 4 5 6))
((1 2) (3 4) (5 6))

BTW, the following is an updated definition of 'curry'.

Code Select Expand

(define (curry f)
  (letex ((f f)
          (cargs (args)))
    (lambda ()
      (apply f (append (quote cargs) (args))))))


Lastly, Jeremy's 'andmap?' and 'ormap?' are (respectively) 'every' and 'any' in John's posting.  Lutz's improvements there are actually the same implementation given by Jeremy.



I recommend reading John's post for some more good FP ideas.  Regards, --Rick

[Fanda]

Yes, pretty good ideas.



I don't mind reinventing the wheel as long as it's fun :-) I was just wondering if there could be something added to newLISP that could make it even more powerful. I really like 'apply' and 'map' and it could be interesting to have more of these cool FP functions ;-)



Lutz, what's your opinion?



Fanda

[Fanda]

We could borrow from Haskell:

http://www.haskell.org/ghc/docs/latest/html/libraries/base/Prelude.html">http://www.haskell.org/ghc/docs/latest/ ... elude.html">http://www.haskell.org/ghc/docs/latest/html/libraries/base/Prelude.html



even, odd -> even?, odd?

gcd, lcm -> lcm



- reducing lists (folds)

- special folds



- building lists

- searching lists

- zipping and unzipping lists



Fanda

[rickyboy]

I don't mind reinventing the wheel as long as it's fun :-)

Amen.  I confess to do this also, and for fun's sake only.

I was just wondering if there could be something added to newLISP that could make it even more powerful. I really like 'apply' and 'map' and it could be interesting to have more of these cool FP functions ;-)

Yes I have wondered about this also.  It would be nice to get together and make an FP library with some usage and concept documentation.  There are a bunch of enthusiatic and capable people on this list, so I have no doubt we could accomplish it.  Other languages' primary sources on the matter can really help too.  As you showed us Fanda, a good resource is the Haskell prelude.  Another is some of the Scheme SRFIs (srfi-1 is a good start).  Also I remember a lot of Good Stuff in Graham's _On_Lisp_.



Speaking of _On_Lisp_, one of the main ideas I got from that book is to pick the most efficient implementation of the basic (foundational) FP building blocks which typically will not be written in the FP style.  A programmer who wants to eschew things like assignment need not worry too much since he or she will be using the basic FP blocks without having to "look under the hood" at the imperative anathema.  :-)  He, he, he.



--Ricky