(import srfi-1 srfi-42 (chicken random) format (chicken string) (chicken sort) (chicken process-context))

(define (hasnt happened)
  (- 1 happened))

(define all *)

(define (either . args)
  (hasnt (reduce all 1 (map hasnt args))))

(define (normalize lis)
  (map (cute / <> (reduce + 0 lis)) lis))

(define (dice-add d1 d2 )
  (let ((result (make-vector (sub1 (+ (length d1) (length d2))) 0)))
    (do-ec
     (: a (index i) d1)
     (: b (index j) d2)
     (begin
       (vector-set! result (+ i j) (+ (vector-ref result (+ i j)) (* a b)))))
    (normalize (vector->list result))))

(define (occurrences amount nominator denominator)
  (map (cute * <> (/ (expt denominator amount) (expt nominator amount)))
       (reduce dice-add '(1)  (make-list amount (list (- denominator nominator) nominator)))))

(define (sum lis)
  (reduce + 0 lis))

(define (occurrences->probs occ)
  (if (< (length occ) 2) '()
      (cons (/ (sum (cdr occ)) (sum occ))
	    (occurrences->probs (cdr occ)))))

(define disadvantages
  (list-ec (: d 1 21) (cons (either (/ d 20) (/ d 20)) (string-append (number->string d)  "d"))))

(define advantages
  (list-ec (: d 1 21) (cons (all (/ d 20) (/ d 20)) (string-append (number->string d)  "a"))))

(define vanilla
  (list-ec (: d 1 21) (cons (/ d 20) (number->string d))))

(define d20-expressions
  (delete-duplicates (sort (append vanilla disadvantages advantages) (lambda (a b) (< (car a) (car b))))
		     (lambda (a b) (= (car a) (car b)))))

(define (d20ize fraction)
  (cdr
   (let ((diffs
	  (map (lambda (dexp)
		 (cons (abs (- fraction (car dexp))) (cdr dexp)))  d20-expressions)))
     (assv (apply min (map car diffs)) diffs))))

(define am (string->number (second (argv))))
(define frac (map string->number (string-split (third (argv)) "/")))

;; (do-ec (: roll (index i) (map d20ize (occurrences->probs (occurrences am (first frac) (second frac)))))
;;        (print (format "~@(~:r:~) ~a" (add1 i) roll)))

(do-ec (: a 1 (add1 am))
       (begin
	 (display "- **")
	 (display a)
	 (display "**: ")
	 (do-ec (: roll (index i) (map d20ize (occurrences->probs (occurrences a (first frac) (second frac)))))
		(begin
		  (unless (zero? i) (display ", "))
		  (display roll)))
	 (newline)))