Dynamic list in which the sum of the elements is invariant under changes to the elements

Question

2nd Update

Here's a snapshot of a graphical user interface I'm thinking. I hope this could be self-explanatory and demonstrate the functionalities I mentioned in the 1st update. Thank you all!

Update

I really appreciate Kuba's help. The code greatly helped me to understand the approach of achieving the task. Here I still have a few quick questions in refinement.

1. I saw Kuba set the range of Slider from 0 to 0.99 instead of 1, as an approach to protect all the others becoming 0 at the same time. I'm considering to have a column of Checkbox right next to the slider. Only when the box is checked, the variable would have corresponding updates. So in this case, ideally even all the other elements become 0, (means one of the element is 1 at that time), when that 1-element decreases, all the others should equally increase correspondingly.

2. Is there a way to construct a dynamic list whose length is user-defined, and create corresponding number of sliders? And also, is there a way to allows users to input the value of each element from InputField? That means the variable is Slider-control and InputField-control at same time.

Original Question

I would like to have a dynamic list of five elements such that if one changes, all the others would change correspondingly to keep the sum invariant at 1. This requirement comes from a practical problem where five probabilities always have a total of 1. I would like to have a slider control for each element in the list which can change that element. When any of the sliders is moved, the list should update as described.

My intention was to create a pure function f that would allow the list to be updated following the rule of sum is 1, as the elements of the list were changed. But this didn't work in the way I thought it should.

And here is what I tried:

v = {0.2, 0.2, 0.2, 0.2, 0.2};
v[[1]] = Dynamic[val];
Dynamic[val]
Slider[Dynamic[val]]
sum = 1;
Dynamic[v]
f := (#/(sum - #))*(sum - val) &
Slider[Dynamic[v[[1]], f /@ v], {0, 1}]
Slider[Dynamic[v[[2]], f /@ v], {0, 1}]
Slider[Dynamic[v[[3]], f /@ v], {0, 1}]
Slider[Dynamic[v[[4]], f /@ v], {0, 1}]
Slider[Dynamic[v[[5]], f /@ v], {0, 1}]

The algorithm of distribution is that if the first element changes, the other four would change proportionally. For instance, if I change the first 0.5 -> 0 in {0.5, 0.05, 0.1, 0.15, 0.2}, the list would automatically update to {0, 0.1, 0.2, 0.3, 0.4}.

Answer 1

Response to edits:

I don't know if I got all your points but this is the final update done by me :)

v = {0.5, 0.05, 0.1, 0.15, 0.2};
active = Range@Length@v;

update[i_, val_] := (v[[i]] = val;
   With[{range = DeleteCases[active, i]}, 
    v[[range]] = (1 - val) Normalize[v[[range]], Total]]);

updateCheckbox[i_, val_] := 
  If[val, active = Join[active, {i}], active = DeleteCases[active, i]];



Table[With[{i = i},
   {InputField[Dynamic[v[[i]], update[i, #] &], Number],
    Slider[Dynamic[v[[i]], update[i, #] &], {0, .99}],
    Checkbox[Dynamic[MemberQ[active, i], updateCheckbox[i, #] &]]
    }
   ], {i, Length@v}] // Grid

Answer 2

v = {0.5, 0.05, 0.1, 0.15, 0.2};

First we create a pure function to be used by the ith slider that (apart from the ith element) adjusts each element of the list v by the factor r - the proportionality adjustment envisioned:

f[i_, r_] := Function[{val, j}, With[{n = First@j}, If[n =!= i, v[[n]] = val*r]]]

In Dynamic's second argument of the ith slider, the ith list element is first changed according to the slider's setting (v[[i]] = #), the proportionality factor, r, is then calculated ((1 - #)/Total@Delete[v, i]) before being used to multiply v's remaining list elements (via the function f).

Grid[{
      Table[i, {i, 1, Length@v}],
      Table[With[{i = i},
        Slider[Dynamic[v[[i]],
                  (v[[i]] = #; 
                   MapIndexed[f[i, (1 - #)/Total@Delete[v, i]],v])&], 
        {0, .9999}, Appearance -> Vertical]], {i, 1, Length@v}]}]

Dynamic@v
-> {0.5, 0.05, 0.1, 0.15, 0.2}

As per the requested example, setting the first element to 0 now gives the desired result.

Dynamic@v
-> {0., 0.1, 0.2, 0.3, 0.4}

Answer 3

I think it is easier to implement the behavior the OP wants to give the list of probabilities, {p1, ..., p5} by having a setter bar to select the element to be changed and a single animator (slider) to change the value of that element.

First a helper function for normalizing the probabilities after the slider is moved.

adjust[probs_, pk_, k_] :=
  Module[{δ, notPk, σ},
    δ = pk - probs[[k]];
    notPk = Delete[probs, k];
    σ = Total[notPk];
    Insert[(1 - δ/σ) notPk, pk, k]]

With that helper, a demonstration of the specified behavior can be made with pretty simple Manipulate expression

With[{init = ConstantArray[.2, 5]},
  Manipulate[
    Column[{
      probs = adjust[probs, pk, k],
      Row[{"Sum of elements: ", Total @ probs}]}],
    {{probs, init}, None},
    {k, Range @ Length @ init},
    {{pk, init[[1]], Dynamic @ Subscript["p", k]}, 0., 1., .05,
      Appearance -> "Labeled"},
    TrackedSymbols :> {pk}]]

Note that the demo is not limited a list with five elements. Any list of probabilities summing to 1 can be given for init. The 2-nd line of the output may look static, but it is actually dynamically summing the list. That it appears static proves the dynamic normalization is doing its job.

Answer 4

Pure function f specified as requested:

"The algorithm of distribution is that if the first [or any] element changes, the other four would change proportionally."

v = {0.2, 0.2, 0.2, 0.2, 0.2};

f = Function[{z, k},
   {a, b, c, d, e} = v;
   m = n = o = p = q = 1;
   Switch[k,
    1, a = z; m = 0,
    2, b = z; n = 0,
    3, c = z; o = 0,
    4, d = z; p = 0,
    5, e = z; q = 0];
   sol = Solve[a x^m + b x^n + c x^o + d x^p + e x^q == 1, x];
   xsol = First[x /. sol];
   v = {a xsol^m, b xsol^n, c xsol^o, d xsol^p, e xsol^q}];

{Dynamic@v, Row[{"Total = ", Dynamic[Total[v]]}]}

Slider[Dynamic[v[[1]], f[#, 1] &]]
Slider[Dynamic[v[[2]], f[#, 2] &]]
Slider[Dynamic[v[[3]], f[#, 3] &]]
Slider[Dynamic[v[[4]], f[#, 4] &]]
Slider[Dynamic[v[[5]], f[#, 5] &]]