Fun with MAP

For the Compleat Fan
Locked
Jeremy Dunn
Posts: 95
Joined: Wed Oct 13, 2004 8:02 pm
Location: Bellingham WA

Fun with MAP

Post by 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 all

(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
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by 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
Posts: 95
Joined: Wed Oct 13, 2004 8:02 pm
Location: Bellingham WA

Post by 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 all

;; 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
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

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

Code: Select all

(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
Last edited by Lutz on Thu Jul 06, 2006 12:52 pm, edited 2 times in total.

Sammo
Posts: 180
Joined: Sat Dec 06, 2003 6:11 pm
Location: Loveland, Colorado USA

Post by Sammo »

Hi Lutz,

Should 'pairs' be as follows:

Code: Select all

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

Jeremy Dunn
Posts: 95
Joined: Wed Oct 13, 2004 8:02 pm
Location: Bellingham WA

Post by 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 all

(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 all

(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
Posts: 289
Joined: Mon Oct 07, 2002 2:48 pm
Location: Blue Mountain College, MS US

Post by 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
Posts: 95
Joined: Wed Oct 13, 2004 8:02 pm
Location: Bellingham WA

Post by 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 all

(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
Posts: 253
Joined: Tue Aug 02, 2005 6:40 am
Contact:

Post by 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 all

;; (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 all

;; (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
Posts: 253
Joined: Tue Aug 02, 2005 6:40 am
Contact:

Post by 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 all

;; (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 all

;; (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 all

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

> (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 all

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

Code: Select all

> (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 all

;; 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
Posts: 95
Joined: Wed Oct 13, 2004 8:02 pm
Location: Bellingham WA

Post by 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
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Post by 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.

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 all

(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 all

(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 all

(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 all

(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
(λx. x x) (λx. x x)

Fanda
Posts: 253
Joined: Tue Aug 02, 2005 6:40 am
Contact:

Post by 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
Posts: 253
Joined: Tue Aug 02, 2005 6:40 am
Contact:

Post by Fanda »

We could borrow from Haskell:
http://www.haskell.org/ghc/docs/latest/ ... elude.html

even, odd -> even?, odd?
gcd, lcm -> lcm

- reducing lists (folds)
- special folds

- building lists
- searching lists
- zipping and unzipping lists

Fanda

rickyboy
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Post by rickyboy »

Fanda wrote: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.
Fanda wrote: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
(λx. x x) (λx. x x)

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

My 3 euros-worth:

1: it would be great to have lots of cool new functions in newLISP, particularly general purpose ones that could be used anywhere and that save us having to write them ourselves.

2: newLISP should continue to be small and concise, without having a proliferation of functions that are rarely used...

3: newLISP should continue to run extremely quickly and launch instantaneously, and mustn't get much larger - don't want it to be larger than 300Kbytes or so... :-)

But to be serious - i can see that the three pillars of newLISP - expressive power, speed, and size - are related, but I don't know how important each one is or how the balance might change in the future. Only Lutz can tell us that.

Perhaps more modules or libraries would be helpful, so that there's a standard set of functions available on all installations that individuals could modify if they wanted to but rely on being there.

Or perhaps new functions should be added to the main system only if they prove to be sufficiently general purpose, or that are otherwise difficult to write in newLISP. I suppose 'unify' was in the latter category...

Another good thing about having more functions of the type described here is that they'll get more widely used if they're built in. And that could also promote good programming. (At my level, I'm all in favour of that!)

Is the compact size of newLISP an advantage in the days of 200GB disks and broadband internet? Or does size still mean speed?

rickyboy
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Post by rickyboy »

Cormullion,

I like your presentation of the three pillars -- so much that I would consider it worth more than a mere 3 Euros. (I can barely get a good Frape in Athens for 3 Euro. :-) By the way, I thought you were dealing in Pounds anyway -- are you not on the Island?

Curious,
--Rick
(λx. x x) (λx. x x)

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

(yes, officially we use the pound sterling, even in rural england, but we're in europe too, so a nodding familiarity with the euro is useful, expecially if we go on holiday!)

Fanda
Posts: 253
Joined: Tue Aug 02, 2005 6:40 am
Contact:

Post by Fanda »

Feel free to contribute more functions and examples (and some theory) to FP library:
http://newlisp-on-noodles.org/wiki/index.php/Fp

Fanda

rickyboy
Posts: 607
Joined: Fri Apr 08, 2005 7:13 pm
Location: Front Royal, Virginia

Post by rickyboy »

Fanda wrote:Feel free to contribute more functions and examples (and some theory) to FP library:
http://newlisp-on-noodles.org/wiki/index.php/Fp
Hey Fanda,
Check out the new composer I added there. It pre-builds the lambda expression like your imperative version.
Cheers! --Rick
(λx. x x) (λx. x x)

nikus80
Posts: 16
Joined: Tue Nov 21, 2006 2:19 pm
Location: argentina

Fun with builders!

Post by nikus80 »

maybe this should go on the wiki, but a negator could be useful too. given a function, it returns a function which applies not to the result. And for example there is no need to define (elem?) and (not-elem?). Also useful for mapping, filtering, etc.

sketch:

Code: Select all

(define (negate fun)
  (letex (fun fun)
    (fn () (not (apply fun (args))))))
example:

Code: Select all

> (map number? '(1 2 3 "hi"))
(true true true nil)
> (map (negate number?) '( 1 2 3 "lol"))
(nil nil nil true)
EXTRA EDIT:
I've been playing around and after trying a lil bit to make an loop/iter macro for newLISP, I came to a better idea, I hope you like it!

It's the collector idea. In common lisp

(loop for e in lst collect (+ e 1))

does exactly what it seems to. It conses a all the elements in the list plus one. Identic to

(map (fn (e) (+ e 1) lst)

The cool thing about the loop macro is that you can mix thing a lil bit. Instead of iterating over a list you could iterate numbers. And write

(loop for e from 1 to 10 collect (+ e 1))

To do that you would have to use a sequence and map, build a list and throw it away, like this:

(map (fn (e) (+ e 1) (sequence 1 10))

But this way you have to replicate in sequence everything you could do with a normal for. And not to mention that besides collecting you can append, sum, etc. and you can insert ifs and then do filtering, everything with loop only
Now, instead of a overly complicated loop macro, I present you to the simple newLisp collector!

Code: Select all

(collector 
	(dolist (e lst)
 	(if (and (number? e) (> e 1))
		(build (+ 1 e)))))
It does what it looks likes. Every call to build is macroexpanded to a call to (set), accumulating a list and then returning it.

for example, if lst would have been (1 2 3 "a b" k 13)) it would have evaluated to (3 4 14).
The cool thing here is that unlike map, you can iterate over anything.

Code: Select all

> [cmd]
 (collector 
 	(for (e 1 10)
 	(if (> e 3)
		(build (+ 1 e)))))
[/cmd]

(5 6 7 8 9 10 11)
Now, the real thing here is that you can easily make you own builders.
(custom-builder) is a function that receives the base case and a function that receives the building value and the total count symbol, and returns a list of code so you can make you own builders. And (builder) is a simple macro that allows to make simple builders on-the-fly, instead of of the more general (custom-builder), it receives a function with is to be applied to the total and current value and the total is set to the value returned. E.G.

Code: Select all

> (builder * 1 (for (i 1 4) (build i)))
24

Maybe I'm reinventing the wheel, but it seems fun!


Oh, I almost forgot!

Code: Select all

(define-macro (collector)
	(let (collector-list '())
	(eval
		(cons 'begin
		(expand (args) 
		   '((build 
			'(lambda (element) 
				(push element collector-list -1)))))))
	collector-list))
(define (custom-builder)
   (expand 
	'(let (building basecase)
		(eval
			(cons 'begin
			(expand (args) 
				'((build 
					(fn (element) 
						(build-function element 'building)))))))
			building)
	(list (list 'build-function (args 0)) (list 'basecase (args 1)))))
(define-macro (builder fun base)
	(letex (fun fun base base)
	(eval (custom-builder 
		(fn (num total) (set total (fun num (eval total))))
		base))))
(btw, I think they're not very hygenic and I'm not sure how nested builder works, besides maybe a "builder collector" would be good if I want to build on the outer collector, but that would be very rare I think.)

Jeremy Dunn
Posts: 95
Joined: Wed Oct 13, 2004 8:02 pm
Location: Bellingham WA

Post by Jeremy Dunn »

I ran into a situation where I wanted to map to individual items of sublists of a list. For instance, I wanted to be able to write something like

(mymap abs '(-1 -2 '(-3 -4)))

and get back (1 2 (3 4)) where ALL subitems are processed and the nesting is preserved in the answer. Anyone have an easy way to do this? If the regular MAP function operated like this would it cause unexpected problems?

Fanda
Posts: 253
Joined: Tue Aug 02, 2005 6:40 am
Contact:

Post by Fanda »

Let's try this simple "recursive map":

Code: Select all

;; recursive map
;;
(define (rmap f lst)
  (let (result '())
    (dolist (l lst)
      (if (list? l)
        (push (rmap f l) result -1)
        (push (f l) result -1)))
    result))

Code: Select all

> (rmap abs '(-1 -2 (-3 -4)))
(1 2 (3 4))

> (define (twice x) (* 2 x))
(lambda (x) (* 2 x))
> (rmap twice '(-1 -2 (-3 -4)))
(-2 -4 (-6 -8))

> (rmap twice (rmap abs '(-1 -2 (-3 -4))))
(2 4 (6 8))
Fanda

jopython
Posts: 123
Joined: Tue Sep 14, 2010 3:08 pm

Re: Fun with MAP

Post by jopython »

I didn't know there were so many variations of map.
Mindblowing, even though this thread is 6 years old.

Locked