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

Question

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

15

我正在尝试弄清楚是否可能实现以下Mathematica接口。

我想在Mathematica中创建一个接口，使用户能够以图形和互动的方式定义任意数量的数字参数，受限于某个约束条件。

所涉及的参数是 [0,1] 范围内的数字权重，每个权重都与相应的标准相关联，并被限制为总和为一。显然，这种约束条件会导致可以与每个标准相关联的权重之间存在取舍，我希望通过拥有交互式绘图来明显地显示这种取舍，类似于以下内容（不幸的是它是在Excel中制作的）：

在此示例中，有6个标准，但我希望将其推广到任意数量（例如2至7个）。

该接口将通过沿着相应轴拖动多边形顶点（对应于特定权重）来工作，并使其他顶点调整以保证它们总是相加为1。

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

我四处寻找，似乎找不到有同样问题的人（搜索查询的定义是非平凡的，可能）。

在Mathematica的示例中，我找到的最接近的东西是locator pane的以下应用程序，在正方形上允许移动3个点，并返回它们的位置：

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

- MatteoS

请注意，Dynamic[]及其相关函数难以掌控。我不建议使用它们来开始学习Mma。 - Dr. belisarius

明白了，谢谢!;-) 实际上，我正在逐步建立，但我需要确保这个特定的接口可以在Mathematica中完成，因为我考虑将我写的整个软件移植到MMA，而这是其中一个关键部分。 - MatteoS

请记住，您可以与其他编程语言进行接口。 - Dr. belisarius

2个回答

10

也许可以这样做

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

- Heike

不是你的错，但我发现这种界面几乎无法使用。 - Dr. belisarius

1

当您移动一个点时，其余的点会缩小。例如，尝试移动一个点，然后通过移动它们将它们全部设置为相等。 - Dr. belisarius

1

我必须说，我对这两个答案印象深刻，但是这个回答恰好传达了我所考虑的图形权衡。你们俩做得很好，谢谢！关于@belisarius的评论，我明白他的意思，但是是否可以通过添加一个“重置”按钮来将所有权重设置为1/n来简单解决这个问题呢？ - MatteoS

当然，在这种情况下，当标准数量增加时，交互式多边形的默认大小相对较小，并且在1/n周围的值的微小变化很难实现。也许可以将轴的比例设置为对数比例以解决这个问题，你觉得呢？ - MatteoS

@MateoS 所以尝试将两个权重设置为其余部分的两倍值。 - Dr. belisarius

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Dr. belisarius · Accepted Answer

也许可以这样做：

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

图片描述