(use-modules (ice-9 streams))
; Narayana algorithm, yoba.
(define (permutations first-perm)
(define (next-permutation perm)
(define (split-descending-part items)
(if (or (null? items) (null? (cdr items)))
#f
(let ((parts (split-descending-part (cdr items))))
(cond (parts (cons (cons (car items) (car parts))
(cdr parts)))
((< (car items) (cadr items))
(list (list (car items))
(car items)
(cdr items)))
(else #f)))))
(define (inject-and-reverse pivot items)
(define (iter new-pivot items tail)
(let ((current-value (car items)))
(if (and (not new-pivot)
(or (null? (cdr items))
(< (cadr items) pivot)))
(begin
(set! new-pivot (car items))
(set! current-value pivot)))
(let ((new-tail (cons current-value tail)))
(if (null? (cdr items))
(cons new-pivot new-tail)
(iter new-pivot (cdr items) new-tail)))))
(iter #f items '()))
(define (combine prefix new-pivot tail)
(if (null? (cdr prefix))
(cons new-pivot tail)
(cons (car prefix)
(combine (cdr prefix) new-pivot tail))))
(let ((parts (split-descending-part perm)))
(if (not parts)
(reverse perm)
(let* ((prefix (car parts))
(pivot (cadr parts))
(tail (caddr parts))
(injection (inject-and-reverse pivot tail))
(new-pivot (car injection))
(new-tail (cdr injection)))
(combine prefix new-pivot new-tail)))))
(make-stream
(lambda (perm)
(cons perm (next-permutation perm)))
first-perm))
(define (range begin end)
(if (< begin end)
(cons begin (range (+ begin 1) end))
'()))
(define (method-ringing size length player1 player2)
(define (print-permutations count perms)
(if (not (zero? count))
(let ((perm (stream-car perms)))
(for-each
(lambda (x)
(display
(cond ((= x player1) "*")
((= x player2) "#")
(else " "))))
perm)
(newline)
(print-permutations (- count 1) (stream-cdr perms)))))
(print-permutations length (permutations (range 1 (+ size 1)))))
(let* ((size (read))
(length (read)))
(method-ringing size length 2 size))