ナラティブコレクションの左上を引くのに必要な回数

Table of Contents

• 1. 計算に使ったコード
• 2. 結果

ナラティブコレクションとはナラティブダンジョンに付属する報酬システムで、9つのマスに書かれたアイテムをナラティブダンジョンで手に入れたアイテムを消費して引く。 その際、左上のマスを引くと盤面を更新できるようになる(なお、そのまま最後まで引き続けても良い)。 盤面を新しくすると、追加でコレクション報酬リストの報酬を獲得できる(これが一番おいしかったりする)。

この記事では、その盤面を更新するのに必要な回数の期待値を計算する。

1 計算に使ったコード

(defvar +lst+ '(1 1 1 4 4 4 15 15 15))
(defvar +prb+ (list (/ 1 60) (/ 1 60) (/ 1 60) (/ 4 60) (/ 4 60) (/ 4 60) (/ 15 60) (/ 15 60) (/ 15 60)))

(defun sum (xs)
  (loop :for x :in xs
	:sum x))

(defmacro foo-maker (prb)
  (let ((ps (reverse (mapcar #'sum (maplist #'identity (reverse prb))))))
    (when (/= (car (last ps)) 1) (warn "The sum of given probalities is not 1 but ~A." (car (last ps))))
    `(defun foo (x)
       (cond . ,(loop :for p :in ps
		      :for i :from 0
		      :collect `((<= x ,p) ,i))))))

(foo-maker #.+prb+)

(defun complete-trial ()
  (loop :with lst := (coerce +lst+ 'vector)
	:with counter := 0
	:until (= (elt lst 0) 0)
	:do (let ((n (foo (random 1.0))))
	      (when (> (elt lst n) 0)
		(decf (elt lst n))
		(incf counter)))
	:finally (return counter)))

(defun sum2 (xs)
  (loop :for x :across xs
	:sum x))

(defun e (fd)
  (let ((n (sum2 fd)))
    (loop :for i :below (length fd)
	  :sum (* 1.0 i (/ (elt fd i) n)))))

(defun prettify (fd)
  (remove nil 
	  (loop :for i :below (length fd)
		:collect (when (> (elt fd i) 0)
			   `(,(write-to-string i) ,(elt fd i))))))

(defun main (n)
  (loop :with result := (make-array `(,(1+ (sum +lst+))))
	:repeat n
	:do (incf (elt result (complete-trial)))
	:finally (return `(:number-of-trails ,n :expectation ,(e result) :frequency-distribution ,(prettify result)))))

;; (main 10) => 43.100002
;; (main 100) => 33.329998
;; (main 1000) => 37.39
;; (main 10000) => 36.8941
;; (main 100000) => 37.07265
;; (main 1000000) => 37.003162
;; (main 10000000) => 36.973404

2 結果

コレクションを一つ進めるのに必要な回数は平均すると37.0回。

Created: 2021-09-16 木 18:16

Emacs 25.2.1 (Org mode 8.2.10)

Validate