6
$\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}]
    ]
   }
  ]
 ]
$\endgroup$
6
$\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

$\endgroup$
  • 2
    $\begingroup$ You don't need PointSize[Large], Black, before Locator[...] $\endgroup$ – m_goldberg Nov 24 '19 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$ – Xuemei Gu Nov 24 '19 at 16:05
  • $\begingroup$ Thank you @m_goldberg. Removed it. $\endgroup$ – kglr Nov 24 '19 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$ – kglr Nov 24 '19 at 16:41
  • $\begingroup$ ... For arbitrary number of locators see LocatorPane and the option LocatorAutoCreate in the docs. $\endgroup$ – kglr Nov 24 '19 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
$\endgroup$
  • 1
    $\begingroup$ @kglr has done all the heavy lifting; I'm just presenting an minor variant for the OP consideration. $\endgroup$ – m_goldberg Nov 24 '19 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$ – Xuemei Gu Nov 24 '19 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$ – Xuemei Gu Nov 24 '19 at 17:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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