Jump to content

Permutations/Derangements: Difference between revisions

no edit summary
(New post.)
imported>Rowsety Moid
No edit summary
Line 366:
!12= 176214841
</pre>
 
=={{header|Acornsoft Lisp}}==
 
Memory limits on machines like the [[wp:BBC_Micro|BBC Micro]] mean that we'd run out of memory if we tried to make a list of all permutations of a list longer than 6 or so elements. Permutations are therefore generated recursively one at a time and given to a ''visitor'' function. The recursion is effectively ''n'' nested loops for a list of length ''n'' and so is not a major obstacle in itself.
 
<syntaxhighlight lang="lisp">
(defun subfact (n)
(cond
((eq n 0) 1)
((eq n 1) 0)
(t (times (sub1 n)
(plus (subfact (sub1 n))
(subfact (sub1 (sub1 n))))))))
 
(defun count-derangements (n (count . 0))
(visit-derangements (range 1 n)
'(lambda (d) (setq count (add1 count))))
count)
 
(defun visit-derangements (original-items d-visitor)
(visit-permutations original-items
'(lambda (p)
(cond ((derangement-p original-items p)
(d-visitor p))))))
 
(defun derangement-p (original d (fail . nil))
(map '(lambda (a b) (cond ((eq a b) (setq fail t))))
original
d)
(not fail))
 
(defun visit-permutations (items p-visitor)
(visit-permutations-1 items '()))
 
(defun visit-permutations-1 (items perm)
(cond
((null items) (p-visitor (reverse perm)))
(t
(map '(lambda (i)
(visit-permutations-1
(without i items)
(cons i perm)))
items))))
 
'( Utilities )
 
(defun without (i items)
(cond ((null items) '())
((eq (car items) i) (cdr items))
(t (cons (car items) (without i (cdr items))))))
 
(defun reverse (list (result . ()))
(map '(lambda (e) (setq result (cons e result)))
list)
result)
 
(defun range (from to)
(cond ((greaterp from to) '())
(t (cons from (range (add1 from) to)))))
 
(defun length (list (len . 0))
(map '(lambda (e) (setq len (add1 len)))
list)
len)
 
'( Examples )
 
(defun examples ()
(show-derangements '(1 2 3 4))
(printc)
(map '(lambda (i)
(printc i
'! (count-derangements i)
'! (subfact i)))
(range 0 8)))
 
(defun show-derangements (items)
(printc 'Derangements! of! items)
(visit-derangements items print))
</syntaxhighlight>
 
{{Out}}
 
Calling <code>(examples)</code> will output:
 
<pre>
Derangements of (1 2 3 4)
(2 1 4 3)
(2 3 4 1)
(2 4 1 3)
(3 1 4 2)
(3 4 1 2)
(3 4 2 1)
(4 1 2 3)
(4 3 1 2)
(4 3 2 1)
 
0 1 1
1 0 0
2 1 1
3 2 2
4 9 9
5 44 44
6 265 265
7 1854 1854
8 14833 14833
</pre>
 
The comparison table stops at ''n = 8'' because, since numbers are 16-bit integers, the program can't count as high as 133496. It can, however, generate all of those derangements.
 
=={{header|Ada}}==
Anonymous user
Cookies help us deliver our services. By using our services, you agree to our use of cookies.