9
$\begingroup$

I have a color wheel domain which is used to describe complex numbers. I want to know is it possible to add a black spot which can be moved by mouse dynamically and return the complex number values of the spot's position?

Is it possible to do this by Manipulate or something similar? I'm not so familiar with the dynamically coding and I know how to make color wheel from the halirutan and others' answers.

fig1

Does anyone know this? Is it like adding a black bottom in the color wheel and then obtain the values when move the spot by mouse?

I appreciate all the comments and suggestions from you! Thank you very much!

--------------------additional question -----------------------------------

one additional thing: how to return the spot's complex values to a certain variables? I show the following example:

I have the following code, that I can adjust the angle phi1 and radial R1 which stands for a complex value and then automatically change the color. 

RectangleC1 = Rectangle[{0, 0}, {3, 3}];

Manipulate[
 With[
  {RegionC1 = R1 (Cos[phi1] + I*Sin[phi1])},

  Region1S = Abs[RegionC1]^2/4;
  If[Re[RegionC1] == 0 && Im[RegionC1] == 0, Region1Phi = 0,
   If[N[ArcTan[Re[RegionC1], Im[RegionC1]]] <= 0, 
     Region1Phi = N[ArcTan[Re[RegionC1], Im[RegionC1]]]/(2 Pi) + 1, 
     Region1Phi = N[ArcTan[Re[RegionC1], Im[RegionC1]]]/(2 Pi)];
   ];

  Icolorstyle = {Hue[Region1Phi, 1, 1, Region1S]};
  Graphics[{EdgeForm[{Thickness[0.001], Gray}], {Icolorstyle[[1]], 
     RectangleC1}}]
  ],
 {phi1, 0, 2 Pi}, {R1, 0, 1}
 ]

fig2

So what I do is: 

RectangleC1 = Rectangle[{2, -2}, {5, 3}];
With[
 {pts = Append[#, First[#]] &@
    Table[{r {Cos[phi], Sin[phi]}, phi/(2 Pi)}, {phi, 0, 
      2 Pi, .1}, {r, 0, 1, .1}]},
 DynamicModule[
  {pt = {.5, .5}},
  Region1S = pt[[1]]^2 + pt[[2]]^2;
  If[pt[[1]] == 0 && pt[[2]] == 0, Region1Phi = 0,
   If[N[ArcTan[pt[[1]], pt[[2]]]] <= 0, 
     Region1Phi = N[ArcTan[pt[[1]], pt[[2]]]]/(2 Pi) + 1, 
     Region1Phi = N[ArcTan[pt[[1]], pt[[2]]]]/(2 Pi)];
   ];
  Icolorstyle = {Hue[Region1Phi, 1, 1, Region1S]};
  Graphics[
   {Polygon[{{0, 0}, First[#1], First[#2]}, 
       VertexColors -> (Hue /@ {{0, 0, 1}, Last[#1], Last[#2]})] & @@@
      Partition[pts[[All, -1, {1, 2}]], 2, 1], 
    Locator[Dynamic[pt, (pt = If[Norm[#] < 1, #, Normalize[#]]) &], 
     Style["\[FilledCircle]", FontSize -> 10]], Icolorstyle[[1]], 
    RectangleC1}, PlotLabel -> Dynamic[Style[pt, 16]]]
  ]
 ]

the result is: fig3

It doesn't automatically change the color when I move the black spot in the color wheel. Which part is missing? Thank you so much for all your help!

figure out one solution:

RectangleC1 = Rectangle[{3, -2}, {6, 2}];
With[{pts = 
   Append[#, First[#]] &@
    Table[{r {Cos[phi], Sin[phi]}, phi/(2 Pi)}, {phi, 0, 2 Pi, .1}, {r, 0, 2, .1}]},
 DynamicModule[{pt = {.5, .5}},
  {
   Graphics[{Polygon[{{0, 0}, First[#1], First[#2]}, 
        VertexColors -> (Hue /@ {{0, 0, 1}, Last[#1], Last[#2]})] & @@@
       Partition[pts[[All, -1, {1, 2}]], 2, 1], 
     Locator[Dynamic[pt, (pt = If[Norm[#] < 2, #, Normalize[#]]) &], 
      Style["1\[FilledCircle]", FontSize -> 8]]}, 
    PlotLabel -> Dynamic[Style[pt, 12]]],

   Dynamic[
    Region1S = (pt[[1]]^2 + pt[[2]]^2);
    If[pt[[1]] == 0 && pt[[2]] == 0, Region1Phi = 0, 
     If[N[ArcTan[pt[[1]], pt[[2]]]] <= 0, 
       Region1Phi = N[ArcTan[pt[[1]], pt[[2]]]]/(2 Pi) + 1, 
       Region1Phi = N[ArcTan[pt[[1]], pt[[2]]]]/(2 Pi)];
     ];
    Icolorstyle = {Hue[Region1Phi, 1, 1, Region1S]};
    Graphics[{Icolorstyle[[1]], RectangleC1}]
    ]
   }
  ]
 ]
Improve this question
$\endgroup$
0

2 Answers 2

Reset to default
8
$\begingroup$

You can add a Locator to this answer by halirutan:

With[{pts = Append[#, First[#]] & @ Table[{r {Cos[phi], Sin[phi]}, phi/(2 Pi)}, 
    {phi, 0, 2 Pi, .1}, {r, 0, 1, .1}]}, 
 DynamicModule[{pt = {.5, .5}}, 
  Graphics[{Polygon[{{0, 0}, First[#1], First[#2]}, 
       VertexColors -> (Hue /@ {{0, 0, 1}, Last[#1], Last[#2]})] & @@@
      Partition[pts[[All, -1, {1, 2}]], 2, 1],
   Locator[Dynamic[pt, (pt = If[Norm[#] < 1, #, Normalize[#]]) &], 
     Style["●", FontSize -> 16]]}, PlotLabel -> Dynamic[Style[pt, 16]]]]]

enter image description here

Improve this answer
$\endgroup$
7
  • 2
    $\begingroup$ You don't need PointSize[Large], Black, before Locator[...] $\endgroup$ Commented Nov 24, 2019 at 15:38
  • $\begingroup$ @kglr, this is very nice! Thank you very much for your help. Do you know how to add more spots if possible? $\endgroup$ Commented Nov 24, 2019 at 16:05
  • $\begingroup$ Thank you @m_goldberg. Removed it. $\endgroup$ Commented Nov 24, 2019 at 16:30
  • 1
    $\begingroup$ @XuemeiGu, you can do something like DynamicModule[{pt1 = {.5, .5}, pt2 = {-.5, -.5}}, Graphics[{Polygon[{{0, 0}, First[#1], First[#2]}, VertexColors -> (Hue /@ {{0, 0, 1}, Last[#1], Last[#2]})] & @@@ Partition[pts[[All, -1, {1, 2}]], 2, 1], Locator[Dynamic[pt1, (pt1 = If[Norm[#] < 1, #, Normalize[#]]) &], Style["\[FilledCircle]", FontSize -> 16]], Locator[Dynamic[pt2, (pt2 = If[Norm[#] < 1, #, Normalize[#]]) &], Style["\[FilledSquare]", FontSize -> 16]]}, PlotLabel -> Dynamic[Column[{pt1, pt2}]]]]. $\endgroup$ Commented Nov 24, 2019 at 16:41
  • $\begingroup$ ... For arbitrary number of locators see LocatorPane and the option LocatorAutoCreate in the docs. $\endgroup$ Commented Nov 24, 2019 at 16:41
6
$\begingroup$

Here is kglr's solution rewritten using LocatorPane, which I think makes the code a little simpler and perhaps clearer. I have also made some changes.

  • the locator is configured to appear a sa disk
  • the plot label shows the position of the disk as a complex number
With[
  {pts =
     Append[
       #,
       First[#]]& @ Table[{r {Cos[phi], Sin[phi]}, phi/(2 Pi)}, 
                          {phi, 0, 2 Pi, .1}, {r, 0, 1, .1}]},
  DynamicModule[{pt = {.5, .5}},
    LocatorPane[
      Dynamic[pt, (pt = If[Norm[#] < 1, #, Normalize[#]]) &], 
      Graphics[
        {Polygon[{{0, 0}, First[#1], First[#2]}, 
           VertexColors -> (Hue /@ {{0, 0, 1}, Last[#1], Last[#2]})]& @@@
         Partition[pts[[All, -1, {1, 2}]], 2, 1]}, 
        PlotLabel -> Dynamic[Style[Complex @@ pt, 16, Black]]], 
      Appearance -> Graphics[{Disk[pt, Scaled[.01]]}]]]]

pane

Update

The following code allows the user to add and remove points from the graphics.

With[
  {pts =
     Append[
      #, 
      First[#]]& @ Table[{r {Cos[phi], Sin[phi]}, phi/(2 Pi)}, 
                         {phi, 0, 2 Pi, .1}, {r, 0, 1, .1}]},
  DynamicModule[{constrain, dots = {{.5, .5}}},
    constrain = If[Norm[#] < 1, #, Normalize[#]] &;
    LocatorPane[
      Dynamic[dots, (dots = constrain /@ #) &], 
      Graphics[
        {Polygon[
           {{0, 0}, First[#1], First[#2]}, 
            VertexColors -> 
              (Hue /@ {{0, 0, 1}, Last[#1], Last[#2]})] & @@@
         Partition[pts[[All, -1, {1, 2}]], 2, 1],
         Dynamic[Disk[#, Scaled[.01]] & /@ dots]},
        PlotLabel -> Dynamic[Style[Column[Complex @@@ dots], 16, Black]]],
      LocatorAutoCreate -> True,
      Appearance -> None]]]

pane

Note

In V11.3, the Documentation Center's instructions for adding and deleting locators are wrong, at least for Mathematica running on MacOS. The correct way to do it is:

  • Add a locator: left click on it while holding down Command+Option
  • Remove a locator: left click on it while holding down Command
Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ @kglr has done all the heavy lifting; I'm just presenting an minor variant for the OP consideration. $\endgroup$ Commented Nov 24, 2019 at 15:42
  • $\begingroup$ wow, thank you so much!!!! That's amazing! by the way, do you know how to add more spots in the disk? In you code, I try to add as{pt1 = {.5, .5}, pt2 = {.15, .15}, pt3 = {.1, .15}}, and extend your code but failed. $\endgroup$ Commented Nov 24, 2019 at 16:01
  • $\begingroup$ @m-goldberg, thank you so much. In the end, i post a small question that changing the Rectangle's color by the spot. Later I use something likereal1 = Dynamic[pt[[1]]]; Im1 = Dynamic[pt[[2]]]; Region1S = (real1^2 + Im1^2)/2;Region1Phi = N[ArcTan[real1, Im1]] , there I can change the transparancy but the color stay one color-- which means the Region1Phi doesn't change. I don't know why. could you have a look the question in the end? $\endgroup$ Commented Nov 24, 2019 at 17:55

Your Answer

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.