如何在约束下以图形方式定义参数值？

Question

我试图弄清楚是否可以实现以下 Mathematica 接口。

我想在 Mathematica 中创建一个界面，用户可以在受约束的情况下以图形方式和交互方式定义任意数量的数值参数。

问题中的参数是数字权重[0,1]，每个权重都与相应的标准相关联，并且限制为总和为一。显然，这个约束导致了与每个标准相关的权重的权衡，我想通过沿着下面的线绘制一个交互式图（不幸的是，在 Excel 中制作），以图形方式使这种权衡变​​得明显：

在这个例子中，有 6 个标准，但我想将其概括为任意数字（例如 2 到 7 之间）。

该界面的工作原理是沿着相应的轴拖动每个多边形顶点（对应于特定的权重），并让其他顶点均匀调整，使它们的总和始终为 1。

然后返回数值以用于后续计算。

我环顾四周，似乎找不到有同样问题的人（搜索查询的定义可能并不简单）。

我在 Mathematica 的示例中发现的最接近的东西是定位器窗格的以下应用，其中允许在正方形上移动 3 个点并返回它们的位置：

DynamicModule[{pt = {{1, 1} /2, {-1, 1}/2, {1, -1}/2}}, {LocatorPane[ 动态[pt]，图形[{灰色，磁盘[]}]]，动态[pt]}]

Answer 1

也许是这样的：

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

Answer 2

也许像这样的

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

屏幕截图：