Back to some functional programming, after all my regex hell. I'm trying to get a permutation example working (which I found at
(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....
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
(if (empty? items)
'(())
(apply append
(map (lambda (element)
(map (lambda (permutation) (cons element permutation))
(permutations (clean (fn (x)(= x element)) items))))
items))))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
nil
(apply list ...
change to:
'(())
(apply append ...
Thanks Fanda - it's like you wave a magic wand and fix my mistakes...!
:)
instead of:
do:
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
Quote from: "Lutz"
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!
A few more changes to the cormullion/Fanda version of
(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
((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. I still love to rehash it. What fun!
Oh, by the way, you'll need these too.
(define (remove1 elt lst)
(let ((elt-pos (find elt lst)))
(if elt-pos (pop lst elt-pos))
lst))
Indeed I was referring to your version at (//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.
Hey cormullion!
Cool! Can you use the builtin
P.S. -- I really like your webpage formatting code. Keep up the good work.
see my last post in this thread:
Lutz
Quote from: "cormullion"
//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. :-)
Quote from: "Lutz"
Lutz
Oh yeah, I got that. And I liked it -- see my post this thread, in response to your post:
Quote from: "rickyboy"
However, it's vitally important for
(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
Quote from: "Ricky"
oh, I see, yes then the 'pop' approach is the one I would choose too.
Lutz
You're right,
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... :-)
If you just want to make combinations (not permutations) here is a function I came up with:
(define (combinations n k (r '()))
(if (= (length r) n)
(list (sort r <))
(apply append (map (fn (x) (combinations n ((+ 1 $idx) k) (cons x r))) k))))
Careful, it can blow up quickly and eat all your memory. For better memory effiency, I'd use dolist and an accumulator variable. For my purposes, creating all possible poker hands, it worked quickly and well.
Here is a sample of how to call the "combinations" function:
> (combinations 2 '(a b c))
((a b) (a c) (b c))
I have updated the function, now it doesn't blow up the stack, keeps memory usage within very small bounds:
;; n is the set of elements
;; k is the number of elements to choose
(define (combinations n k (r '()))
(if (= (length r) k)
(list r)
(let (rlst '())
(dolist (x n)
(setq rlst (append rlst
(combinations ((+ 1 $idx) n) k (append r (list x))))))
rlst)))
This version also corrects a problem with the arguments; n is supposed to represent the set, and k the number of elements to "choose". Previous version of the function had this reversed. It is now proper standard behavior.
However, be warned; this new version is 6 times slower than the version that uses up all your ram. Any ideas on how to speed it up?
As an example, the memory efficient version took 77 seconds to calculate all possible poker hands in a deck of cards. The fast version using map took 11 seconds. So, a 7x speed difference.
Now if only there was a way to speed things up. I don't like a 7x speed hit just to stay within memory bounds.
They have some very nice LOGIC programming theory online too..
You can gain a magnitude in speed by taking some more care in avoiding copying, as in the following
(if (empty? items) '()
(1 items)
(let ((e (cons (first items))) (n (length items)))
(flat (map (fn (p (i -1)) (collect (append (0 (inc i) p) e (i p)) n))
(permutations (rest items)))
1))
(list items)))
and a similar care to
(if (<= (length items) k) (list items)
(= k 1) (map list items)
(append (combinations (rest items) k)
(map (curry cons (first items))
(combinations (rest items) (dec k))))))
I've been time testing
The funny thing is, that when repeating this a number of times, the time goes up some 100 ms on each test.
For example, for the first 20 repetitions (clipped to ms), I got: 2854, 2498, 2523, 2589, 2600, 2671, 2752, 2908, 2968, 3132, 3191, 3516, 3752, 4162, 4256, 4556, 4644, 4895, 5005, 5180 ms, in that order,
Then, for the next 20 got: 5340, 5513, 5640, 5880, 6057, 6294, 6412, 6601, 6736, 6910, 7051, 7302, 7485, 7659, 7849, 8111, 8291, 8480, 8730, 8929 ms, in that order.
and so on.
Doing
It looks like it'd be some memory management bug, but I haven't been able to find out where; I'm still scouting.
This concerns newlisp 10.6.4 as of 2015-09-18 5:10pm +10:00, with version line:
newLISP v.10.6.4 32-bit on Linux IPv4/6 UTF-8 libffi.
newLISP frees most memory allocated immediately to the OS. Only unused cell structures are kept in a free-cell list for reuse. This normally leads to faster performance avoiding to call memory allocation and deallocation routines in the OS every time for lisp cells.
The slowdown on repeated execution of a function is extremely rare, normally repeated execution of a program with a mixture of different functions will never slow down. In most cases the cell recycle-list speeds up program execution.
In your specific case you could avoid slow down by inserting a
(define (permutations items)
(if (empty? items) '()
(begin (reset nil) (1 items))
(let ((e (cons (first items))) (n (length items)))
(flat (map (fn (p (i -1)) (collect (append (0 (inc i) p) e (i p)) n))
(permutations (rest items)))
1))
(list items)))
This destroys the cell recycling pool. This usage of
Right. Yes, as far as I can work it out, it really appears to be due to something deteriorating when the distance between consecutive free cells grows.
I simplified the testing code down to the following (though I'm sure there are better ways):
(dotimes (j 100) (println (time (dotimes (i 10000) (0 (* 10 i) A)))))
Then I instrumented the code so each
Basically it suggests that when the address distance between consecutive freed cells is large, it takes longer time to allocate; which is what the implicit indexing does. I would guess this is due to some page caching (kernel or processor) becoming ineffective, and there's not much a newlisp user can do about it. Adding