Some side problem in a manipulate notebook

Question

Sorry for the length of the code but the question is only on the Manipulate part.

Here are some functions to evaluate apportionment methods

hamapp[v_, s_] := Module[{vv = v, ss = s}, d = Total[vv]/ss;
   q = N[vv/d];
  qq = \[LeftFloor]q\[RightFloor];
  res = q - qq;(*reste*)
  raa = ss - Total[qq];(*reste à attribuer*)
  raa1 = Table[1, {i, Length[vv]}];
  res1 = Table[
    If[MemberQ[Ordering[res, raa, #1 > #2 &], i], qq[[i]] + raa1[[i]],
      qq[[i]]], {i, Length[qq]}]]
jeffapp[v_List, s_Integer] := 
 Module[{x}, 
  Floor[v/x] /. FindRoot[Total@Floor[v/x] == s, {x, 1, Total[v]}]]
lownapp[v_List, s_] := Module[{vv = v, ss = s},
  If[Length[vv] > ss, 
   Print[Style[
     "Number of seat is lower than the number of group -> \
Unapplicable method", 18, Red, Bold]],
    al0 = N[(vv/Total[vv]) ss];(* q *)
   al1 = \[LeftFloor]al0\[RightFloor];(* \[LeftFloor]q\[RightFloor] *)


   pos = Position[al1, 
     0];(*position des groupes qui ont un \[LeftFloor]q\[RightFloor] \
nul *)
   al2 = Table[If[MemberQ[pos, {i}], 1, al1[[i]]], {i, Length[al1]}];(* 
   On donne un bien à tous les groupe dont \[LeftFloor]q\[RightFloor] \
= 0*)
   decpart = 
    Table[If[al1[[i]] > 0, al0[[i]] - al1[[i]], 0], {i, 
      Length[al0]}];(* 
   On calcule le vecteur des restes décimaux q-\[LeftFloor]q\
\[RightFloor] et remplace cette valeur par 0 pour tous les groupes \
qui ont reçu un objet dans l'étape précédente pour se garantir qu'on \
ne leur en donnera pas un autre *) 
   rest = ss - Total[al2]; (* 
   on évalue le nombre d'objets qui n'ont pas encore été alloués *)
   al3 = Table[1, {i, Length[al0]}]; (* on forme un vecteur de 1 *)
   al4 = Table[
     If[MemberQ[Ordering[decpart, rest, #1 > #2 &], i], 
      al2[[i]] + al3[[i]], al2[[i]]], {i, Length[al1]}]
   (* On trie dans l'ordre décroissant decpart et on sélectionne \
uniquement les rest premiers termes par leur numéro d'ordre dans \
decpart. Puis on alloue un objet supplémentaire aux groupes qui ont \
été sélectionnés *)
   ]]

adamsapp[v_List, s_Integer] := 
 Module[{x}, 
  Ceiling[v/x] /. 
   FindRoot[Total@Ceiling[v/x] == s, {x, Total[v]/s, Total[v]}]]
hillhungapp[v_, s_] := Module[{vv = v, ss = s, x},
  xhh = FindRoot[
    Total@Table[
        With[{i = i}, 
         If[(vv[[i]]/x) > 
           Sqrt[Floor[(vv[[i]]/x)] Ceiling[(vv[[i]]/x)]], 
          Ceiling[(vv[[i]]/x)], Floor[(vv[[i]]/x)]]], {i, 
         Length[vv]}] - ss == 0, {x, 1, Total[vv]}];
  Table[With[{i = i}, 
     If[(vv[[i]]/x) > Sqrt[Floor[(vv[[i]]/x)] Ceiling[(vv[[i]]/x)]], 
      Ceiling[(vv[[i]]/x)], Floor[(vv[[i]]/x)]]], {i, Length[vv]}] /. 
   xhh]
deanapp[v_, s_] := Module[{vv = v}, ww = DeleteCases[vv, 0];
  var = Array[x, Length[ww]];
  obj = Total[
    Table[Log[(x[i]!)^3 2^(x[i] - 
           1)/(x[i]^2 ww[[i]]^(x[i] - 1) ((2 x[i] - 1)!))], {i, 
      Length[ww]}]];
  const = Total[var];
  cons1 = And @@ Thread[var > 0];
  int = var \[Element] Integers;
  argmin = ArgMin[{obj, const == s && cons1 && int}, var];
  zer = ConstantArray[0, Length[vv] - Length[ww]];
  fin = Flatten[{argmin, zer}];
  Fold[Insert[#1, 0, #2] &, DeleteCases[fin, 0], Position[vv, 0]]]
websterapp[v_, s_] := Module[{vv = v, ss = s, x},
  xweb = FindRoot[
    Total@Table[
        With[{i = i}, 
         If[(vv[[i]]/x) > 
           0.5 (Floor[(vv[[i]]/x)] + Ceiling[(vv[[i]]/x)]), 
          Ceiling[(vv[[i]]/x)], Floor[(vv[[i]]/x)]]], {i, 
         Length[vv]}] - ss == 0, {x, 1, Total[vv]}];
  Table[With[{i = i}, 
     If[(vv[[i]]/x) > 0.5 (Floor[(vv[[i]]/x)] + Ceiling[(vv[[i]]/x)]),
       Ceiling[(vv[[i]]/x)], Floor[(vv[[i]]/x)]]], {i, 
     Length[vv]}] /. xweb]
qbpy[n_, v_, as_] := 
 Block[{x = v, y = as, h = n}, r = Range[Length[x]];
  qq = N[v/Total[v] h];
  t = Table[{r[[i]], 
     If[(y + 1)[[i]] > \[LeftCeiling]qq\[RightCeiling][[i]], -1, 
      N[v[[i]]/(y[[i]] + 1)]]}, {i, Length[y]}];
  pt = Sort[t, #1[[2]] > #2[[2]] &];
  ttt = Table[
    If[i == pt[[1, 1]], y[[i]] = y[[i]] + 1, y[[i]]], {i, Length[as]}]]
balyouapp[v_, s_] := 
 Fold[qbpy[#2, v, #] &, ConstantArray[0, Length[v]], Range[s]]

Sorry for the french commentaries.

Then

SetOptions[Manipulator, Appearance -> Labeled]
Pane[Panel[
  Style[Framed[
    Manipulate[(vv = {v[1], v[2], v[3]}; s = sn; 
      Grid[{{Style["Hamilton", Blue], "", 
         hamapp[vv, s]}, {Style["Jefferson", Blue], "", 
         jeffapp[vv, s]}, {Style["Lowndes", Blue], "", 
         lownapp[vv, s]}, {Style["Adams", Blue], "", 
         adamsapp[vv, s]}, {Style["Hill-Huntington", Blue], "", 
         hillhungapp[vv, s]}, {Style["Webster", Blue], "", 
         websterapp[vv, s]}, {Style["Dean", Blue], "", 
         deanapp[vv, s]}, {Style["Balinski-Young", Blue], "", 
         balyouapp[vv, s]}}, 
       Background -> {{LightYellow, LightYellow, LightYellow}}]), {{v[
        1], 50}, 1, 10000, 1, Appearance -> "Labelled"}, { {v[2], 50},
       1, 10000, 1}, {{ v[3], 50}, 1, 10000, 1, 
      Appearance -> "Labelled"}, {{ sn, 5}, 4, 45, 1, 
      Appearance -> "Labelled"}, 
     FrameLabel -> {{"", 
        ""}, {Style["Méthode de Répartition de Biens Indivisibles", 
         Red, Bold, 16, FontFamily -> "Bell MT"], ""}}],
    FrameMargins -> 30, RoundingRadius -> 10], 
   DefaultOptions -> {Panel -> {Background -> LightYellow}}]], Full, 
 Alignment -> Center]

If I have made no errors in copying the code here is the result.

As you can see it looks like if there is an error. So I have tried to define the two cells as initialization cell. But after I can't move the sliders.

Then I ask the sliders to be labeled and obviously they are'nt.

At last I would like all the background yellow and the labels in the same font than the text.

Thanks for the help.

Answer 1

Take FrameLabel out of your Manipulate expression and don't try to move manipulators with a range of 1 to 10000 by 1 unit (that is less than one pixel of movement).

The error is from FindRoot (as is clearly indicated). That's not a Manipulate problem and I don't address it.

This version of your Manipulate expression works.

SetOptions[Manipulator, Appearance -> "Labeled"];
Manipulate[
 vv = {v[1], v[2], v[3]};
 s = sn;
 Grid[{{Style["Hamilton", Blue], "", 
    hamapp[vv, s]}, {Style["Jefferson", Blue], "", 
    jeffapp[vv, s]}, {Style["Lowndes", Blue], "", 
    lownapp[vv, s]}, {Style["Adams", Blue], "", 
    adamsapp[vv, s]}, {Style["Hill-Huntington", Blue], "", 
    hillhungapp[vv, s]}, {Style["Webster", Blue], "", 
    websterapp[vv, s]}, {Style["Dean", Blue], "", 
    deanapp[vv, s]}, {Style["Balinski-Young", Blue], "", 
    balyouapp[vv, s]}}, 
  Background -> {{LightYellow, LightYellow, LightYellow}}],
 {{v[1], 50}, 50, 10000, 50},
 {{v[2], 50}, 50, 10000, 50},
 {{v[3], 50}, 50, 10000, 50},
 {{sn, 5}, 4, 45, 1}]