Searching for chocolates

chocolates.m

(* https://possiblywrong.wordpress.com/2015/02/08/searching-for-chocolates/ *)

d[n_, k_] := If[! (0 <= k <= n), 0,
   Sum[
    (-1)^j Binomial[k, j] (n - j)!,
    {j, 0, k}
    ]
   ]

v[n_, k_] := v[n, k] = Which[
    k < 0 || n < 0 || k > n, 0,
    d[n, k] === 0, 0,
    k === 1, n / 2,
    True, Min[
     1 + ((k - 2) d[n - 1, k - 2] v[n - 1, k - 2] +
          (n - k) d[n - 1, k - 1] v[n - 1, k - 1])/d[n, k],
     1 + ((k - 1) d[n - 1, k - 1] v[n - 1, k - 1] +
          (n - k) d[n - 1, k] v[n - 1, k])/d[n, k]
     ]
    ]

(* Brute-force calculation of minimum expected number of guesses. *)
f[states_List, unchecked_List] := f[states, unchecked] = Module[
    {guess, u, reveal},
    Min@Map[
      (
        guess = #;
        u = DeleteCases[unchecked, guess];
        Mean@Map[
          (
            reveal = #[[guess]];
            
            1 + If[reveal === 1, 0, 
              f[Select[states, #[[guess]] === reveal &], u]]
            ) &,
          states
          ]
        ) &,
      unchecked
      ]
    ]

n=5; f[Derangements[Range[n]], Range[n]]] === v[n, n]