A minimization which works but not too much

 A minimization which works but not too much

Here under is a method to calculate Dean’s apportionment method

dean[v_, s_] := Module[{vv = v, ss = s}, ww = DeleteCases[vv, 0];
  var = Table[x[i], {i, Length[ww]}];
  obj = Total[
    Table[Log[(x[i]!)^3 Rationalize[2^(
         x[i] - 1)]/(x[i]^2 ww[[i]]^(x[i] - 1) ((2 x[i] - 1)!))], {i, 
      Length[ww]}]];
  const = Total[Table[x[i], {i, Length[ww]}]];
  cons1 = 
   ToExpression[
    StringReplace[
     ToString[Table[x[i] >= 0, {i, Length[ww]}]], {"{" -> "", 
      "}" -> "", "," -> " &&"}]];
  int = ToExpression[
    StringReplace[
     ToString[
      Table[x[i] ∈ Integers, {i, Length[ww]}]], {"{" -> "", 
      "}" -> "", "," -> " &&"}]];
  argmin = ArgMin[{obj, const == ss && cons1 && int}, var];
  zer = Table[0, {i, 1, Length[vv] - Length[ww]}];
  fin = Join[argmin, zer];
  Fold[Insert[#1, 0, #2] &, DeleteCases[fin, 0], Position[vv, 0]]]
dean[{0, 40, 20, 12, 0}, 20]

It works nicely until s=20. But at s=21, it fails. It’s the same thing if I increase the length of v. Of course, I have tried to change ArgMin to NArgMin and some methods but it doesn’t ameliorate the situation. Mathematica complains of a division by 0. Is there a way to resolve this problem?

Let’s block ads! (Why?)

Recent Questions – Mathematica Stack Exchange