Question

I’m trying to figure out whether it’s possible to implement the following Mathematica interface.

I would like to create an interface in Mathematica whereby the user would be able to define graphically and interactively an arbitrary number of numerical parameters, subject to a constraint.

The parameters in questions are numerical weights [0,1], each associated to a corresponding criterion and constrained to summing to one. Obvously, this constraint induces a trade-off to the weights that can be associated to each criterion and I wanted to make such trade-off evident graphically, by having an interactive plot along the line of what follows (made in Excel, unfortunately):

In this example, there are 6 criteria, but I would like to generalize that to an arbitrary number (between 2 and 7, for instance).

The interface would work by dragging each of the polygon vertices (corresponding to a specific weight) along the corresponding axis, and having the others adjust uniformely so that they always sum to 1.

The numerical values would then be returned to be used in subsequent computations.

I have looked around and do not seem to be able to find someone who had the same problem (the definition of the search queries is non-trivial, probably).

The closest thing I’ve found among Mathematica’s examples is the following application of the locator pane, where 3 points are allowed to be moved on a square and their position is returned:

DynamicModule[{pt = {{1, 1}/2, {-1, 1}/2, {1, -1}/2}}, {LocatorPane[
Dynamic[pt], Graphics[{Gray, Disk[]}]], Dynamic[pt]}]

Answer 1

Maybe something like this

Manipulate[
 DynamicModule[{mags, pts, bkgrnd, corners},
  corners = N@Table[{Sin[2 Pi i/n], Cos[2 Pi i/n]}, {i, n}];
  mags = N@Table[1/n, {n}];
  pts = mags corners;
  bkgrnd = {{FaceForm[Opacity[0]], EdgeForm[Gray], 
     Polygon[ Table[r corners, {r, .2, 1, .2}]]},
    Table[
     Text[Row[{"Criterion ", i}], 
      1.05 corners[[i]], -corners[[i]]], {i, n}]};

  LocatorPane[
   Dynamic[
    pts, (mags = Norm /@ #; mags = mags/Total[mags]; 
      pts = mags corners) &],
   Dynamic@Graphics[{bkgrnd,
      {FaceForm[], EdgeForm[{Thick, Blue}], Polygon[pts]},
      Table[
       Text[NumberForm[mags[[i]], {4, 2}], 
        pts[[i]], -1.8 corners[[i]]], {i, n}]}, PlotRange -> All],
   Appearance -> Graphics[{PointSize[.02], Point[{0, 0}]}]]],

 {{n, 3}, Range[3, 7]}]

Screenshot: