added two more libraries
[k8-xscheme:k8-xscheme.git] / lib / unsort.scm
1 (xs:libinfo unsort
2   (exports unsort))
3
4 ; SketchyLISP Example Program
5 ; Copyright (C) 2005,2006,2007 Nils M Holm. All rights reserved.
6 ; See the file LICENSE of the SketchyLISP distribution
7 ; for conditions of use.
8 ;
9 ; ---name---
10 ; unsort
11 ;
12 ; ---purpose---
13 ; Generate some entropy by un-sorting a list of
14 ; natural numbers. The order of the list
15 ; .V a
16 ; is changed in a hard to predict way by extracting
17 ; the
18 ; .V (n mod length[a])'th
19 ; element from
20 ; .V a
21 ; and consing it to
22 ; .V b.
23 ; Each extracted element is removed from
24 ; .V a.
25 ; When
26 ; .V a
27 ; is empty, the result is in
28 ; .V b.
29 ;
30 ; ---args---
31 ; A - list to unsort
32 ; SEED - first element to arrange, where 0<SEED<=length[A]
33 ;
34 ; ---example---
35 ; :l src/iota.scm
36 ; (unsort (iota 1 5) 3) => (3 2 5 1 4)
37
38 (define (unsort a seed)
39   (letrec
40     ; Remove n'th element.
41     ((rem-nth
42        (lambda (a n r)
43          (cond ((zero? n)
44              (if (null? a)
45                  (reverse r)
46                  (append (cdr a) (reverse r))))
47            (else (rem-nth (cdr a) (- n 1)
48                           (cons (car a) r))))))
49      ; Unsort list A of length K
50      ; N = element to extract
51      ; R = intermediate result
52      (_unsort
53        (lambda (a n k r)
54          (cond ((zero? k) (cons (car a) r))
55            (else (_unsort (rem-nth a n '())
56                           (remainder (car a) k)
57                           (- k 1)
58                           (cons (list-ref a n) r)))))))
59     (_unsort a seed (- (length a) 1) '())))
60
61 #!eof
62
63 (format #t "~w\n~w\n" (unsort (1 2 3 4 5) 3)  (3 2 5 1 4))