我正在试图弄清楚是否可以实现以下Mathematica接口。
我想在Mathematica中创建一个界面,用户可以根据约束以图形方式和交互方式定义任意数量的数值参数。
问题中的参数是数字权重[0,1]
,每个都与相应的标准相关联,并被约束为求和。显而易见,这种约束导致了对可以与每个标准相关联的权重的权衡,并且我希望通过沿着下面的线(不幸地在Excel中制作)的交互式绘图以图形方式进行这种权衡:
在这个例子中,有6个标准,但我想将其概括为任意数字(例如,在2到7之间)。
界面可以通过沿着相应的轴拖动每个多边形顶点(对应于特定的权重),并使其他顶点均匀调整,使它们总和为1。
然后返回数值以用于后续计算。
我环顾四周,似乎找不到有同样问题的人(搜索查询的定义可能非常重要)。
我在Mathematica的例子中发现的最接近的事情是定位器窗格的以下应用,其中允许在正方形上移动3个点并返回它们的位置:
DynamicModule[{pt = {{1, 1}/2, {-1, 1}/2, {1, -1}/2}}, {LocatorPane[
Dynamic[pt], Graphics[{Gray, Disk[]}]], Dynamic[pt]}]
答案 0 :(得分:12)
也许是这样的:
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]]}]
答案 1 :(得分:9)
也许是这样的
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]}]
截图: