CL-USER> (carry-out-experiment 1000000
                               2/9)
Done experiments: 1000000
Succesfull experiments: 222154
Failed experiments: 0
Success probability: 111077/500000
Theoretical probability: 2/9
Probability relative deviation: 0.030709427%
NIL
CL-USER> ;; для 5-ти МФТИ-ков и 5 вагонов результат должен быть
(/ (calc-lib:fact 5)
   (expt 5 5))
24/625
CL-USER> (let ((*students* '(5 14)) ; остальных студентов пусть будет 14
               (*carriages-number* 5))
           (carry-out-experiment 1000000
                                 24/625))
Done experiments: 1000000
Succesfull experiments: 38491
Failed experiments: 0
Success probability: 38491/1000000
Theoretical probability: 24/625
Probability relative deviation: 0.23641892%
NIL
CL-USER> ;; для 7-и МФТИ-ков и столько же вагонов результат должен быть
(/ (calc-lib:fact 7)
            (expt 7 7))
720/117649
CL-USER> (let ((*students* '(7 34)) ; остальных студентов пусть будет 34
               (*carriages-number* 7))
           (carry-out-experiment 1000000
                                 720/117649))
Done experiments: 1000000
Succesfull experiments: 6276
Failed experiments: 0
Success probability: 1569/250000
Theoretical probability: 720/117649
Probability relative deviation: 2.4872687%
NIL
CL-USER> 

(in-package :cl-user)

(defparameter *students*
  '(3 6))

(defparameter *carriages-number* 3)

(defun students-in-set ()
  (destructuring-bind (from-m oth)
      *students*
    (let ((set (list)))
      (loop :while t
            :do (push (let ((sum (+ from-m
                                    oth)))
                        (if (zerop sum)
                            (return-from students-in-set
                              set)
                            (if (< (random sum)
                                   from-m)
                                (progn
                                  (decf from-m)
                                  t)
                                (progn
                                  (decf oth)
                                  nil))))
                      set)))))

(defun check-set (set)
  (destructuring-bind (from-m oth)
      *students*
    (and (= (length set)
            (+ from-m
               oth))
         (let ((m 0))
           (dolist (x set)
             (when x
               (incf m)))
           (= m
              from-m)))))

(defun set-building-test ()
  (time
   (block fin
     (dotimes (n 1500000) 
       (unless (check-set (students-in-set))
         (return-from fin nil)))
     t)))

(defun fill-carriages (set)
  (let ((cars (loop :repeat *carriages-number*
                    :collect (list))))
    (loop :while set
          :do (push (pop set)
                    (nth (random *carriages-number*)
                         cars)))
    cars))

(defun test-carriages (carriages)
  (every (lambda (car)
           (= (length
               (remove-if #'not
                          car))
              1))
         carriages))

(defun model (count)
  (let ((set-errors 0)
        (ok-num 0))
    (dotimes (n count)
      (let ((set (students-in-set)))
        (if (check-set set)
            (when (test-carriages (fill-carriages set))
              (incf ok-num))
            (incf set-errors))))
    (values ok-num
            set-errors)))

(defun carry-out-experiment (number-exps
                             theoretical-probability)
  (multiple-value-bind (ok-num stack-errors)
      (model number-exps)
    (let ((prob (/ ok-num
                   number-exps)))
      (format *standard-output* "Done experiments: ~D
Succesfull experiments: ~D
Failed experiments: ~D
Success probability: ~A
Theoretical probability: ~A
Probability relative deviation: ~F%~%"
              number-exps
              ok-num
              stack-errors
              prob
              theoretical-probability
              (handler-case
                  (* 100.0
                     (/ (abs (- theoretical-probability
                                prob))
                        prob))
                (division-by-zero () nil))))))