Functional programming - permutations

[cormullion]

Back to some functional programming, after all my regex hell. I'm trying to get a permutation example working (which I found at http://www.stanford.edu/class/cs107/archive/06-07-spring/handouts/33-Scheme-Examples.pdf">Stanford...

Code Select Expand

(define (func element items)
  (map (fn (permutation) (cons element permutation))
       (permutations (clean
                     (fn (f) (= element f))
                     items))))

(define (permutations items)
    (if (nil? items)
        nil
        (apply list
           (map
           (fn (f) (func f items))
           items
           ))))

(println (permutations '(1 2 3 4)))

;-> (((1 (2 (3)) (2 (4))) (1 (3 (2)) (3 (4))) (1 (4 (2)) (4 (3)))) ((2
   (1 (3))
   (1 (4)))
  (2 (3 (1)) (3 (4)))
  (2 (4 (1)) (4 (3))))
 ((3 (1 (2)) (1 (4))) (3 (2 (1)) (2 (4))) (3 (4 (1)) (4 (2))))
 ((4 (1 (2)) (1 (3))) (4 (2 (1)) (2 (3))) (4 (3 (1)) (3 (2)))))



It looks like it might work if I tweak it a bit.  But there are too many parentheses....

[newdep]

hahaha you just beat me with the link ;-) (got it from Lambda the ulitmate)



They have some very nice LOGIC programming theory online too..



http://standish.stanford.edu/bin/search/simple/process?query=pbk&offset=0">http://standish.stanford.edu/bin/search ... k&offset=0">http://standish.stanford.edu/bin/search/simple/process?query=pbk&offset=0

[Fanda]

Code Select Expand

(define (permutations items)
(if (empty? items)
'(())
(apply append
(map (lambda (element)
(map (lambda (permutation) (cons element permutation))
(permutations (clean (fn (x)(= x element)) items))))
 items))))

Code Select Expand

> (permutations '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

[Fanda]

Code Select Expand

(if (nil? items)
  nil
  (apply list ...

change to:

Code Select Expand

(if (empty? items)
  '(())
  (apply append ...

[cormullion]

Thanks Fanda - it's like you wave a magic wand and fix my mistakes...!



:)

[Lutz]

instead of:

Code Select Expand

(clean (fn (x)(= x element)) items)

do:

Code Select Expand

(replace element (begin items))

and your code gets about 2 1/2 times faster. The 'begin' block wrapper returns a copy of 'items' and makes 'replace' non-destructive removing all occurences of 'element'.



Lutz

[rickyboy]

Code Select Expand

(replace element (begin items))
and your code gets about 2 1/2 times faster. The 'begin' block wrapper returns a copy of 'items' and makes 'replace' non-destructive removing all occurences of 'element'.

Sweet!

[rickyboy]

A few more changes to the cormullion/Fanda version of permutations yields the following more general function k-permutations.

Code Select Expand

(define (k-permutations k multiset)
  (let ((pivots (unique multiset)))
    (if (= k 1)
        (map list pivots)
      (mappend (lambda (p)
                 (map (lambda (k-1-perm) (cons p k-1-perm))
                      (k-permutations (- k 1) (remove1 p multiset))))
               pivots))))

Now you can get permutations of multisets (sets with repeated elements) and permutations of any size k, from 1 to the size of the set.

Code Select Expand

> (k-permutations 3 '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
> (k-permutations 4 '(1 2 3 1))
((1 2 3 1) (1 2 1 3) (1 3 2 1) (1 3 1 2) (1 1 2 3) (1 1 3 2) (2 1
  3 1)
 (2 1 1 3)
 (2 3 1 1)
 (3 1 2 1)
 (3 1 1 2)
 (3 2 1 1))
> (k-permutations 3 '(1 2 3 1))
((1 2 3) (1 2 1) (1 3 2) (1 3 1) (1 1 2) (1 1 3) (2 1 3) (2 1 1)
 (2 3 1)
 (3 1 2)
 (3 1 1)
 (3 2 1))
> (k-permutations 2 '(1 2 3 1))
((1 2) (1 3) (1 1) (2 1) (2 3) (3 1) (3 2))
> (k-permutations 1 '(1 2 3 1))
((1) (2) (3))

The explanation of why this works was given a couple of years ago at http://www.alh.net/newlisp/phpbb/viewtopic.php?t=553">//http://www.alh.net/newlisp/phpbb/viewtopic.php?t=553.  I still love to rehash it.  What fun!



Oh, by the way, you'll need these too.

Code Select Expand

(define (mappend) (apply append (apply map (args))))

(define (remove1 elt lst)
  (let ((elt-pos (find elt lst)))
    (if elt-pos (pop lst elt-pos))
    lst))


[cormullion]

Indeed I was referring to your version at (http://www.tamos.net/~rick/logismoi/">//http://www.tamos.net/~rick/logismoi/) Ricky - but i switched over to the Stanford alternative because I needed a more lengthy commentary..



Now that I have both, perhaps understanding will be doubled!



Presumably you can use the built-in alternative 'remove' that Lutz showed - the Scheme version had to write one specially I think.

[rickyboy]

Hey cormullion!



Cool!  Can you use the builtin replace to remove just one element (which is what my remove1 is supposed to do)?  If so, then great -- I'd love to get rid of remove1.  But I couldn't see how.  :-(



P.S. -- I really like your webpage formatting code.  Keep up the good work.

[Lutz]

see my last post in this thread:

Code Select Expand

(replace element (begin items))

Lutz

[rickyboy]

Indeed I was referring to your version at (http://www.tamos.net/~rick/logismoi/">//http://www.tamos.net/~rick/logismoi/) Ricky ...

Oops, you caught me.  :-)   I'm kind of embarassed that I can't keep up a sustained effort with my own blog.  Sheesh!  I really respect fellows like you, cormullion, who can sustain an effort of good quality blog articles. I've found out that it takes quite a bit of work. (And you've just found out that I may be quite lazy.  :-)

[rickyboy]

see my last post in this thread:

Code Select Expand

(replace element (begin items))
Lutz

Oh yeah, I got that.  And I liked it -- see my post this thread, in response to your post:

Sweet!

However, it's vitally important for k-permutations to be able to remove just one element from the list.  Your usage of replace doesn't do that:

Code Select Expand

> (define x '(1 2 1 3 1 1 4))
(1 2 1 3 1 1 4)
> x
(1 2 1 3 1 1 4)
> (replace 1 (begin x))
(2 3 4)

Is there a way to tell replace to remove just one?

[Lutz]

Is there a way to tell replace to remove just one?

oh, I see, yes then the 'pop' approach is the one I would choose too.



Lutz

[cormullion]

You're right, replace exp list does every one, unlike with strings - must remember that...! i don't think there's a way to do it with match or anything either... So your remove1 is the best at the moment.



Maybe I'm easily impressed, but I just think this type of programming is so cool. It's amazing how something small and modest in size can suddenly explode with activity once it's started, like a bomb or whatever.... The only problem with this type of programming though is that I don't seem to be able to make use of it in the stuff I write. In the 2000-3000 lines of code I've published this year I've barely managed any of this functional programming style, having seen few opportunities to employ it. That's the really clever bit - being able to use these techniques for productive code, rather than simply for learning or exploration.



Thanks for your comments about the newlisp blog - it's just to keep my hands loose and brain ticking over while I'm not more gainfully employed (and when the kids are in bed... :-)