fork download 
  1. (define (cumulate f init n)
  2.   (define (aux acc n)
  3.     (if (= n 0)
  4.         acc
  5.         (aux (f acc n) (- n 1))))
  6.   (aux init n))
  7. (define (factorial n)
  8.   (cumulate * 1 n))
  9. (define (power x n)
  10.   (cumulate (lambda (acc _) (* acc x)) 1 n))
  11. (define (range n)
  12.   (cumulate (lambda (acc n) (cons (- n 1) acc)) '() n))
  13. (define (repeat x n)
  14.   (cumulate (lambda (acc _) (cons x acc)) '() n))
  15. (define (repelem m xs)
  16.   (apply append (map (lambda (x) (repeat x m)) xs)))
  17. (define (delete_at i xs)
  18.   (define (aux j rs xs)
  19.     (cond
  20.      ((null? xs) (cons '() (list (reverse rs))))
  21.      ((= i j) (cons (list (car xs)) (list (append (reverse rs) (cdr xs)))))
  22.      (else (aux (+ j 1) (cons (car xs) rs) (cdr xs)))))
  23.   (aux 0 '() xs))
  24. (define (count f xs)
  25.   (foldl (lambda (acc x) (+ acc (if (f x) 1 0))) 0 xs))
  26. (define (f r m n)
  27.   (define a (repelem m (map (lambda (x) (+ x 1)) (range r))))
  28.   (define x (/ (factorial (* r m)) (power (factorial m) r)))
  29.   (define (aux acc x n a)
  30.     (if (null? a)
  31.         (reverse acc)
  32.         (let* ((y (/ x (length a)))
  33.                (i (floor (/ (remainder (- n 1) x) y))))
  34.           (define-values (d rest) (apply values (delete_at i a)))
  35.           (if (null? d)
  36.               '()
  37.               (let* ((d (car d))
  38.                      (x (floor (* y (+ 1 (count (lambda (x) (= x d)) rest)))))
  39.                      (n (- n (floor (* y (count (lambda (x) (< x d)) rest))))))
  40.                 (aux (cons d acc) x n rest))))))
  41.   (if (or (< n 1) (< x n))
  42.       '()
  43.       (aux '() x n a)))
  44. (print (f 9 1 1))
  45. (print (f 9 1 2))
  46. (print (f 9 1 3))
  47. (print (f 9 1 123456))
  48. (print (f 9 1 234567))
  49. (print (f 9 1 362880))
  50. (print (f 4 3 1))
  51. (print (f 4 3 2))
  52. (print (f 4 3 3))
  53. (print (f 4 3 123456))
  54. (print (f 4 3 234567))
  55. (print (f 4 3 369600))
  56.  
Success #stdin #stdout 0.02s 8216KB
comments (?)
stdin 
Standard input is empty
stdout 
(1 2 3 4 5 6 7 8 9)
(1 2 3 4 5 6 7 9 8)
(1 2 3 4 5 6 8 7 9)
(4 1 6 5 8 9 7 3 2)
(6 8 4 7 5 3 2 1 9)
(9 8 7 6 5 4 3 2 1)
(1 1 1 2 2 2 3 3 3 4 4 4)
(1 1 1 2 2 2 3 3 4 3 4 4)
(1 1 1 2 2 2 3 3 4 4 3 4)
(2 2 2 3 3 1 4 3 4 1 1 4)
(3 2 4 4 2 4 3 3 1 1 1 2)
(4 4 4 3 3 3 2 2 2 1 1 1)
https://ideone.com/n7pIFw
language:
Scheme (chicken 4.13)
created:
25 days ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!