3
$\begingroup$

I want to create an interactive module, where I can plot the vertices of polygon and some points on a circle(for example, suppose a triangle and 3 points on the circle) and move the vertices of the polygon and use the co-ordinates of the vertices of the polygon and the co-ordinates of the points on the circle to create a polynomial and plot the roots of the polynomial, so that I can observe how the roots of the polynomial behave when I move the vertices of the polygon and the points on the circle.

So far I have been able to do this:-

  1. I saw this post on how to create a polygon interactively in this post:- How To interactively create a Polygon in a Graphic?

  2. I saw how to plot points on a circle so that I can move the points in the graphic:- http://reference.wolfram.com/language/ref/LocatorPane.html, but so far I have been able to plot only one point(which I can move) on the circle. Here is the code:-

    DynamicModule[{pt = {0, 1}},
      LocatorPane[
        Dynamic[pt],
        Graphics[{Circle[], PointSize[Large], Dynamic[Point[pt/Norm[pt]]]}],
        Appearance -> None
      ]
    ]
    

Problems:

  1. But I don't know how to get the co-ordinates of the vertices of the polygon and the co-ordinates of the points on the circle to put them in the expression for the polynomial whose roots I want to plot.

  2. Also I want to be able to see how the roots of the polynomial move when I move the vertices of the polygon and the points on the circle, but I have no idea how to do that.

For the sake of simplicity, at the moment, I am assuming the polygon is a triangle and plotting only 3 points on the circle.

In that case, if the vertices of the polygon are $a_1,a_2,a_3$(in complex number) and the points on the circle are $c_1,c_2,c_3$, then the polygon whose roots I want to plot is $ a_1(x-c_2)(x-c_3)+a_2(x-c_1)(x-c_3)+a_3(x-c_1)(x-c_2)$.

I am completely new to Mathematica, so any help would be greatly appreciated.

$\endgroup$
1
  • 1
    $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$
    – Michael E2
    Feb 19, 2016 at 17:18

1 Answer 1

4
$\begingroup$

If anything is not clear, feel free to ask.

First question is, how to create that polynomial from points, in general:

{a1, a2, a3, a4}.Times @@@ (x - Reverse@Subsets[{c1, c2, c3, c4}, {4 - 1}])

enter image description here

enter image description here

With[{ n = 5},

 DynamicModule[{
   polygonPoints = 2. CirclePoints[n],
   circlePoints = 1. CirclePoints[{1, Pi/2.}, n],
   updatePolynomial, polynomial, updateRoots, roots, rootsCoordinates},
  Column[{
    Graphics[{
      Circle[], PointSize[Large],
      Dynamic@Point@circlePoints,
      Table[
       With[{i = i}, 
        Locator[Dynamic[
          circlePoints[[i]], (circlePoints[[i]] = Normalize[#]) &], 
         Appearance -> None]], {i, n}]
      ,
      EdgeForm@Thick, FaceForm@None,
      Dynamic@Polygon@polygonPoints, Dynamic@Point@polygonPoints,
      Table[
       With[{i = i}, 
        Locator[Dynamic[polygonPoints[[i]]], Appearance -> None]], {i,
         n}]
      ,
      Red, AbsolutePointSize@12,
      Dynamic[{Point@rootsCoordinates, 
        Line[{{0, 0}, #} & /@ rootsCoordinates]}]
      },
     PlotRange -> 5, Axes -> True, ImageSize -> 500],
    Dynamic[circlePoints; polygonPoints; updateRoots[]; 
     Column@{polynomial, roots}]
    }]
  ,
  Initialization :> (
    updatePolynomial[] := polynomial =  With[{
         as = Complex @@@ polygonPoints,
         cs = Complex @@@ circlePoints
         },
         as.Times @@@ (\[FormalX] - Reverse@Subsets[cs, {n - 1}])
        ];

    updateRoots[] := (
      updatePolynomial[];
      roots = {ToRules@Roots[0 == polynomial, \[FormalX]]};
      rootsCoordinates = 
       Clip[#, 10^2 {-1, 1}] & /@ ReIm[\[FormalX] /. roots];
      );
    rootsCoordinates = {};
    updateRoots[];
    )]
 ]
$\endgroup$
4
  • $\begingroup$ Thank you very much. If I want to do this with more than 3 points, I mean for example, a quadrilateral and 4 points on the circle and the polynomial will be similar, i.e., $a_1(x-c_2)(x-c_3)(x-c_4)+.....$, exactly which part do I need to edit? $\endgroup$
    – DLN
    Feb 20, 2016 at 9:37
  • $\begingroup$ I tried to change it to CirclePoints[4] at the beginning of the code, but there was an error in calculating the roots of the polynomial. $\endgroup$
    – DLN
    Feb 20, 2016 at 9:39
  • $\begingroup$ Can you please explain this part of the code then? eq = (Complex @@@ polygonPoints).( Times @@@ (x - Reverse@Subsets[Complex @@@ circlePoints, {2}])). As far as I understood, polygonPoints and circlePoints are two lists, but I don't understand how you are accessing the values in the list or making the polynomial with those values. $\endgroup$
    – DLN
    Feb 20, 2016 at 9:45
  • $\begingroup$ @DLN Now you can change n. Also the code should be more readable, any questions? $\endgroup$
    – Kuba
    Feb 20, 2016 at 10:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.