Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to define parameter values graphically, under constraints?

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):

Example of graphical weight definition

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]}]

like image 804
MatteoS Avatar asked Oct 23 '11 17:10

MatteoS


2 Answers

Perhaps something like this:

n = 6;
posText[x_List] := Text[Round[Norm@#/Total@(Norm /@ x), .01], 1.3 #, 
                        Background -> LightRed] & /@ x;
rot = RotationMatrix[Pi/15];
DynamicModule[{
  pt = pti = {Re@#, Im@#} &@(E^(2 I Pi #/n)) & /@ Range@n,
  r  = Array[1 &, n]},
 Column@{LocatorPane[
    Dynamic[pt],
    Framed@Graphics[
      {(*The Arrows*)
       Black, Arrow[{{0, 0}, 1.2 #}] & /@ pt,

       (*The Criteria Numbers*)
       MapIndexed[{Text[Style[#2[[1]],20], #1],Circle[#1,.1]}&, 1.1 rot.#&/@pti],

       (*The Cyan Polygons*)
       FaceForm[None], EdgeForm[Cyan], Polygon[pt #] & /@ Range[.2, 1, .2],

       (*The Points*)
       Black, Dynamic[Point[r = MapThread[#1 Clip[#1.#2, {0, 1}] &, {pti, pt}]]],

       (*The Text legends*)
       Dynamic[posText@ r],

       (*The Red Polygon*)
       EdgeForm[{Red, Thick}], Dynamic[Polygon@r]},

      ImageSize -> 550, PlotRange ->1.5 {{-1, 1}, {-1, 1}}], 
    Appearance -> None],
   (*The Footer*)
   Dynamic[Grid[{Table[Norm@r[[i]], {i, n}]}/Total@(Norm /@ r), Dividers->All]]}]

enter image description here

enter image description here

like image 61
28 revs Avatar answered Oct 25 '22 20:10

28 revs


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:

screenshot

like image 37
Heike Avatar answered Oct 25 '22 22:10

Heike