Как определить значения параметров графически, под ограничения?
Я пытаюсь выяснить, возможно ли реализовать следующий интерфейс Mathematica.
Я хотел бы создать интерфейс в Mathematica, с помощью которого пользователь сможет графически и интерактивно определять произвольное количество числовых параметров с учетом ограничений.
Параметры в вопросах являются числовыми весами [0,1]
, каждый из которых связан с соответствующим критерием и ограничен суммированием до одного. Очевидно, что это ограничение вызывает компромисс с весами, которые могут быть связаны с каждым критерием, и я хотел сделать такой компромисс очевидным графически, имея интерактивный график в соответствии с тем, что следует (сделано в Excel, к сожалению):
![Example of graphical weight definition]()
В этом примере есть 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]}]
![]()
Ответы
Ответ 1
Может быть, что-то вроде этого
Manipulate[
DynamicModule[{mags, pts, bkgrnd, corners},
corners = [email protected][{Sin[2 Pi i/n], Cos[2 Pi i/n]}, {i, n}];
mags = [email protected][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) &],
[email protected][{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]()
Ответ 2
Возможно, что-то вроде этого:
n = 6;
posText[x_List] := Text[Round[[email protected]#/[email protected](Norm /@ x), .01], 1.3 #,
Background -> LightRed] & /@ x;
rot = RotationMatrix[Pi/15];
DynamicModule[{
pt = pti = {[email protected]#, [email protected]#} &@(E^(2 I Pi #/n)) & /@ [email protected],
r = Array[1 &, n]},
[email protected]{LocatorPane[
Dynamic[pt],
[email protected][
{(*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[[email protected] r],
(*The Red Polygon*)
EdgeForm[{Red, Thick}], Dynamic[[email protected]]},
ImageSize -> 550, PlotRange ->1.5 {{-1, 1}, {-1, 1}}],
Appearance -> None],
(*The Footer*)
Dynamic[Grid[{Table[[email protected][[i]], {i, n}]}/[email protected](Norm /@ r), Dividers->All]]}]
![enter image description here]()
![enter image description here]()