Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #59139

Rosetta: Permutations/Derangements (2.)

Show all headers | View raw

> A derangement is a permutation of the order of distinct items
> in which no item appears in its original place.
> 
> For example, the only two derangements of the three items (0,
> 1, 2) are (1, 2, 0), and (2, 0, 1).
> 
> The number of derangements of n distinct items is known as the
> subfactorial of n, sometimes written as !n. There are various
> ways to calculate !n.
> 
> Task
> 
> Create a named function/method/subroutine/... to generate
> derangements of the integers 0..n-1, (or 1..n if you prefer).
> 
> Generate and show all the derangements of 4 integers using the
> above routine.
> 
> Create a function that calculates the subfactorial of n, !n.
> 
> Print and show a table of the counted number of derangements
> of n vs. the calculated !n for n from 0..9 inclusive.

(use combinatorics)

(define (deranged? . lists)  (not (apply any = lists)))

(define (derangements original count?)
  (ordered-subset-fold
    (lambda (perm accum)
      (if (deranged? perm original)
        (if count? (+ 1 accum) (cons perm accum))
        accum))
    (if count? 0 '())
    original))

(define (subfact n)
  (if (< n 2)
    (- 1 n)
    (* (- n 1) (+ (subfact (- n 1)) (subfact (- n 2))))))

(for-each print (derangements '(0 1 2 3) #f))

(for-each
  (lambda(n) (print n " " (derangements (iota n) #t) " " (subfact n)))
  (iota 10))


(1 0 3 2)
(3 0 1 2)
(1 3 0 2)
(2 0 3 1)
(2 3 0 1)
(3 2 0 1)
(1 2 3 0)
(2 3 1 0)
(3 2 1 0)

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
9 133496 133496

-- 
I don't believe in western morality, i.e. don't kill civilians or children....
The only way to fight a moral war is the Jewish way: Destroy their holy sites.
Kill men, women, and children (and cattle). --- Rabbi Manis Friedman
web.archive.org/web/20090605154706/http://www.momentmag.com/Exclusive/2009/2009-06/200906-Ask_Rabbis.html
archive.org/download/DavidDukeVideo/TheZionistMatrixOfPowerddhd.ogv

Back to comp.lang.forth | Previous | Next | Find similar | Unroll thread

Thread

Rosetta: Permutations/Derangements (2.) "Robert L." <No_spamming@noWhere_7073.org> - 2017-05-13 00:35 +0000

csiph-web