Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm trying to adapt Nasser's method for using a control variable inside Manipulate to selectively choose what part of the code should be recalculated depending on the controls changed (see this question).

I need this functionality for a simulation I'm working on about the field lines of an electric dipole.

In the simulation it should be possible to move the two charges q1 and q2 generating the field and also to move a third point P. The point P only serves to see the field line passing through P.

Since the single field line originating from P should have different graphical parameters than the field lines of the "background field", I've created two different Streamplots: "fieldlines" is for the general field and "fieldpoint" is for the single line through P. They are combined together with the "Show" command.

Nasser helped me a lot with the code and his version addresses the problem of the selective recalculation. But in my plan I'd like to use three Locator instead of 3 Slider2D.

Locators are easy to set in a standard Manipulate code, but are not easy to implement in a custom code like the following one:

Manipulate[tick;
 Show[f2, f1, ImageSize -> 300],

 Text@Grid[{
    {Grid[{
       {"Q1"},
       {Slider2D[Dynamic[q1pos, {q1pos = #;
            f1 = fieldlines[q1pos, q2pos, pnts];
            f2 = fieldpoint[q1pos, q2pos, pt];
            tick = Not[tick]} &], {{-6, -6}, {6, 6}, {.1, .1}}]},
       {Dynamic[q1pos]}
       }, Alignment -> Center]}
    ,
    {Grid[{{"Q2"},
       {Slider2D[Dynamic[q2pos, {q2pos = #;
            f1 = fieldlines[q1pos, q2pos, pnts];
            f2 = fieldpoint[q1pos, q2pos, pt];
            tick = Not[tick]} &], {{-6, -6}, {6, 6}, {.1, .1}}]},
       {Dynamic[q2pos]}
       }, Alignment -> Center]}
    ,
    {Grid[{{"pt"},
       {Slider2D[Dynamic[pt, {pt = #;
            f2 = fieldpoint[q1pos, q2pos, pt];
            tick = Not[tick]} &], {{-6, -6}, {6, 6}, {.1, .1}}]},
       {Dynamic[pt]}
       }, Alignment -> Center]}
    }, Spacings -> {.5, 1.5}, Alignment -> Center, Frame -> All
   ]
 ,
 {{tick, False}, None},
 {{q1pos, {-2, 0}}, None},
 {{q2pos, {2, 0}}, None},
 {{pt, {-2.5, 2}}, None},
 {{f1, fieldlines[{-2, 0}, {2, 0}, Tuples[{-3, -2, -1, 0, 1, 2, 3}, 2]]}, None},
 {{f2, fieldpoint[{-2, 0}, {2, 0}, {-2.5, 2}]}, None},
 {{pnts, Tuples[{-3, -2, -1, 0, 1, 2, 3}, 2]}, None},
 ControlPlacement -> Left,
 ContinuousAction -> False,
 SynchronousInitialization -> False,
 TrackedSymbols :> {tick}, 
 Initialization :> (

   field[x_, y_, q1pos_List, q2pos_List] := Module[{},
     {
      (2 (x - q1pos[[1]]))/EuclideanDistance[q1pos, {x, y}]^3 + 
         (-2 (x - q2pos[[1]]))/EuclideanDistance[q2pos, {x, y}]^3
      ,
      (2 (y - q1pos[[2]]))/EuclideanDistance[q1pos, {x, y}]^3 + 
        (-2 (y - q2pos[[2]]))/EuclideanDistance[q2pos, {x, y}]^3}
     ];

   fieldlines[q1pos_List, q2pos_List, pnts_List] := Module[{x, y},
     StreamPlot[field[x, y, q1pos, q2pos], {x, -5, 5}, {y, -5, 5},
      StreamPoints -> pnts, StreamScale -> Automatic , PerformanceGoal -> "Quality"]];

   fieldpoint[q1pos_List, q2pos_List, pt_List] := Module[{x, y},
     StreamPlot[field[x, y, q1pos, q2pos], {x, -5, 5}, {y, -5, 5},
      StreamPoints -> {
        {
         {pt, {Thickness[0.005], RGBColor[1, 0, 0], Arrowheads[0.02]}}
         }, Automatic, {ForwardBackward, 400}}, PerformanceGoal -> "Quality"]
     ]

   )
 ]

So my question to advanced users is if it's possible to substitute the 3 Slider2D controls with 3 Locator in this context without disrupting the selective recalculation achieved so far.

It seem a tough thing to do since these controls are not located in the usual control section of a standard Manipulate command.

Thanks for your help.

share|improve this question
    
BTW, your Slider2D controls will seem more responsive (yes, more) if you use ContinuousAction -> False. (When True, they give the impression that they are frozen.) –  David Carraher Jan 12 at 13:45
    
Wouldn't you need 6 Sliders to replace 3 Slider2Ds ? –  David Carraher Jan 12 at 13:47
    
@DavidCarraher I meant 3 Locator=3 Slider2D (and not simple Slider) –  Luca M Jan 12 at 14:22
add comment

4 Answers 4

See if this works for you.

I still have not figured why a second evaluation is needed. Will look into it later. i.e. after you evaluate first time and the manipulate comes up, you need to hit the cell one more time. Then it works well. I've seen this before and do not remember now the reason for it.

enter image description here

Here is the code. To make it work fast, this is what I did. I used the 3 arguments of dynamics. In the second argument, only moved the charge. This is fast. In the third argument, the calculation are made. i.e. once the mouse is released. You can play with the plot range, and the Locator range as needed in the code.

Manipulate[tick;

 Deploy@Graphics[
   {
    f2[[1]],
    f1[[1]],
    Locator[Dynamic[q1pos, {
       (q1pos = #) &,
       (q1pos = #) &,
       (q1pos = #;
         f1 = fieldlines[q1pos, q2pos, pnts];
         f2 = fieldpoint[q1pos, q2pos, pt];
         tick = Not[tick]
         ) &}], LocatorRegion -> Full],
    Locator[Dynamic[q2pos, {
       (q2pos = #) &,
       (q2pos = #) &,
       (q2pos = #;
         f1 = fieldlines[q1pos, q2pos, pnts];
         f2 = fieldpoint[q1pos, q2pos, pt];
         tick = Not[tick]
         ) &}], LocatorRegion -> Full],
    Locator[Dynamic[pt, {
       (pt = #) &,
       (pt = #) &,
       (pt = #;
         f2 = fieldpoint[q1pos, q2pos, pt];
         tick = Not[tick]
         ) &}], Graphics@{Red, PointSize[.5], Point[pt]}, 
           LocatorRegion -> Full, ImageSize -> 20]
    },
   PlotRange -> {{-6, 6}, {-6, 6}},
   ImageSize -> 300, Axes -> False
   ]
 ,
 {{tick, False}, None},
 {{q1pos, {-2, 0}}, None},
 {{q2pos, {2, 0}}, None},
 {{pt, {-2.5, 2}}, None},
 {{f1, fieldlines[{-2, 0}, {2, 0}, Tuples[{-3, -2, -1, 0, 1, 2, 3}, 2]]}, None},
 {{f2, fieldpoint[{-2, 0}, {2, 0}, {-2.5, 2}]}, None},
 {{pnts, Tuples[{-3, -2, -1, 0, 1, 2, 3}, 2]}, None},
 ControlPlacement -> Left,
 ContinuousAction -> False,
 SynchronousUpdating -> True,
 SynchronousInitialization -> False,
 TrackedSymbols :> {tick},
 Initialization :> (
   field[x_, y_, q1pos_List, q2pos_List] := Module[{},
     {
      (2 (x - q1pos[[1]]))/EuclideanDistance[q1pos, {x, y}]^3 + 
        (-2 (x - q2pos[[1]]))/EuclideanDistance[q2pos, {x, y}]^3
      ,
      (2 (y - q1pos[[2]]))/EuclideanDistance[q1pos, {x, y}]^3 + 
       (-2 (y - q2pos[[2]]))/EuclideanDistance[q2pos, {x, y}]^3}
     ];

   fieldlines[q1pos_List, q2pos_List, pnts_List] := Module[{x, y},
     StreamPlot[field[x, y, q1pos, q2pos], {x, -5, 5}, {y, -5, 5},
      StreamPoints -> pnts, StreamScale -> Automatic , PerformanceGoal -> "Quality"]];

   fieldpoint[q1pos_List, q2pos_List, pt_List] := Module[{x, y},
     StreamPlot[field[x, y, q1pos, q2pos], {x, -5, 5}, {y, -5, 5},
      StreamPoints -> {
        {
         {pt, {Thickness[0.005], RGBColor[1, 0, 0], Arrowheads[0.02]}}
         }, Automatic, {ForwardBackward, 400}}, PerformanceGoal -> "Quality"]
     ]

   )
 ]
share|improve this answer
    
That's great! But isn't it possible to have a continuous action when moving the locator? Even with changing the ContinuousAction -> False, SynchronousUpdating -> True, SynchronousInitialization -> False, options the plot is always updated after having moved the locator. This way the interactivity feeling is somewhat lost... –  Luca M Jan 12 at 17:08
    
@LucaM I am not sure I follow you. Lets make sure we are on same page: To make the display move very fast, only way is not to update the stream plot for each mouse movement, right? But user still wants to see the charge moving with the mouse. So, now the charge moves with the mouse, and the fields are updated when the mouse is released. This is a compromise. If you want the field to update as the mouse moves, easy to do, but will be slow again. Unless number of points is reduced or StreamPlot call optimized, which might be possible but I have not looked at this as I do not use this function –  Nasser Jan 12 at 17:19
    
I can accept that the field updating will slow down the graphics rendering but, however, I'd like that my users (my students) can see what happens while the mouse is dragged (even if the effect will be slower than in your last version with the updating triggered by the mouse button release). My initial concern was about moving the point P (affecting the single field line) that should not be slowed down by the recalculation of the Streamplot of the general field lines. And your code has solved that side of the problem. –  Luca M Jan 12 at 17:39
add comment

Here's a slight variation in Nasser's that's too long to explain in a comment. I changed several things. Think of each thing as a suggestion. The use of ControlActive is helpful in such cases as this, where the updating during active control manipulation needs to be quicker.

Here the number of lines drawn is reduced during dragging, which speeds up StreamPlot.

Also, I find that automatic point selection works better than seeding a bunch of points. StreamPlot's algorithm is fairly sophisticated and I've had poor luck trying to improve it.

Turning off Performance -> "Quality" means the "Speed" option will be chosen when locators are dragged. It will revert to "Quality" when the mouse is released.

The new formula for field does not noticeably help, but I left it in. I suspect StreamPlot auto-compiles it at the appropriate point.

Manipulate[
 LocatorPane[
  Dynamic[{q1pos, q2pos, pt}],
  Dynamic[
   StreamPlot[field[x, y, q1pos, q2pos], {x, -7, 7}, {y, -7, 7}, 
    StreamPoints -> ControlActive[
       {{{pt, {Thickness[0.005], RGBColor[1, 0, 0], Arrowheads[0.02]}}, 10}},
       {{{pt, {Thickness[0.005], RGBColor[1, 0, 0], Arrowheads[0.02]}}, 30}}]
     ]]
  ],

 {{q1pos, {-2, 0}}, None}, {{q2pos, {2, 0}}, None}, {{pt, {-2.5, 2}}, None},

 Initialization :> (
   field[x_, y_, q1pos_List, q2pos_List] := 
     First @ Differences[(2 {{x, y} - q2pos, {x, y} - q1pos}) / 
         {EuclideanDistance[q2pos, {x, y}], EuclideanDistance[q1pos, {x, y}]}^3];
   )]

In response to Luca's comment, you can use Dynamic to separate code to be updated when different locators are moved. Whether this is possible depends mainly on the dependencies in the code, not the controls. The code for updating when q1pos, q2pos are moved is placed outside a Dynamic that contains all the code dependent upon pt. When pt is moved, only the code inside the innermost Dynamic will be updated. When the other two are moved, the code inside the outer Dynamic is updated (include the code inside the inner one).

Manipulate[
 LocatorPane[
  Dynamic[{q1pos, q2pos, pt}],

  Dynamic[
   With[{fieldlines = StreamPlot[field[x, y, q1pos, q2pos], {x, -7, 7}, {y, -7, 7}, 
       StreamPoints -> ControlActive[10, 30]]},

    Dynamic[
     Show[
      fieldlines,
      StreamPlot[field[x, y, q1pos, q2pos], {x, -7, 7}, {y, -7, 7}, 
       StreamPoints -> {{{pt, {Thickness[0.005], RGBColor[1, 0, 0], Arrowheads[0.02]}}}}]
      ]]

    ]]

  ],

 {{q1pos, {-2, 0}}, None}, {{q2pos, {2, 0}}, None}, {{pt, {-2.5, 2}}, None},

 Initialization :> (
   field[x_, y_, q1pos_List, q2pos_List] := 
     First@Differences[(2 {{x, y} - q2pos, {x, y} - q1pos}) / 
       {EuclideanDistance[q2pos, {x, y}], EuclideanDistance[q1pos, {x, y}]}^3];
   )]
share|improve this answer
    
Very elegant code and optimization. Anyway the original core of my question (mathematica.stackexchange.com/questions/40256/… ) has been lost. The real and final optimization could be if the code could avoid to recalculate the blue field lines if only the point P (pt with its single red field line) is moved. That was possible using Nasser's method with 3 Slider2d. It seems that's not possible when using Locators. –  Luca M Jan 13 at 17:44
    
@LucaM See if the update addresses what you're after. –  Michael E2 Jan 13 at 21:48
    
@@Michael E2 That's exactly what I had in mind! Thanks! –  Luca M Jan 13 at 23:50
    
@@Michael E2 I knew I had to gain a better understanding of the Dynamic head (and of the With head). Your code seems to be a perfect example to guide me towards this better understandong... –  Luca M Jan 14 at 0:02
add comment

I optimized the code more, and now, even though all computation is being done for all the locators, it is actually fast. So, I simplified the whole setup, and used LocatorPane instead. So this is complete implementation. Hence making it a new answer. I am still not too happy with the performance, but now at least it shows all the field being updated as the mouse is moving, and it was fast enough for me on windows 7, V 9.01.

enter image description here

Manipulate[
 LocatorPane[Dynamic[{q1pos, q2pos, pt}],
  Dynamic@Graphics[First@fieldlines[q1pos, q2pos, pnts, pt],
    PlotRange -> {{-7, 7}, {-7, 7}}, ImageSize -> 300, Axes -> True]],
 {{q1pos, {-2, 0}}, None},
 {{q2pos, {2, 0}}, None},
 {{pt, {-2.5, 2}}, None},
 {{pnts, N@Tuples[Range[-3, 3], 2]}, None},
 ControlPlacement -> Left,
 ContinuousAction -> True,
 SynchronousUpdating -> True,
 SynchronousInitialization -> False,
 Initialization :> (
   field[x_, y_, q1pos_List, q2pos_List] := 
    Module[{e1 = EuclideanDistance[q1pos, {x, y}]^3, 
      e2 = EuclideanDistance[q2pos, {x, y}]^3},
     {(2 (x - q1pos[[1]]))/e1 - (2 (x - q2pos[[1]]))/e2, 
      (2 (y - q1pos[[2]]))/e1 - (2 (y - q2pos[[2]]))/e2}];

   fieldlines[q1pos_List, q2pos_List, pnts_List, pt_List] := Module[{x, y},
     Show[StreamPlot[field[x, y, q1pos, q2pos], {x, -7, 7}, {y, -7, 7},
       StreamPoints -> pnts, StreamScale -> Automatic , PerformanceGoal -> "Quality"],
      StreamPlot[field[x, y, q1pos, q2pos], {x, -7, 7}, {y, -7, 7},
       StreamPoints -> {{{pt, {Thickness[0.005], RGBColor[1, 0, 0], 
         Arrowheads[0.02]}}}},
       PerformanceGoal -> "Quality"]]]
   )
 ]
share|improve this answer
    
Do you think compiling field would help? Don't have time to test right now... –  Ajasja Jan 13 at 10:33
    
Thanks Nasser. I think that this could be the definitive version. The delay with ContinuousAction -> True is acceptable, and the code is amazingly short and compact. Too bad you had to give up with the "tick" variable that seemed a promising solution in cases like this and worked fine with the Slider2D (damn locators...). –  Luca M Jan 13 at 13:26
add comment
up vote 1 down vote accepted

Final solution (thanks for the answers)

This addition is just to confirm and summarize the answers already given by Nasser and Michael E2 to the question I asked. The problem was to find a way to combine 2 different StreamPlot and a DensityPlot without the heavier computationally ones being uselessly recalculated when simply acting on controls that shouldn't affect them.

Actually in my simulation of the electric dipole there are 3 locators: q1p and q2p for the positions of the charges generating the field and ptp for the position of a point in which to probe the field. There are also two sliders to control the 2 charges values (qq1 and qq2). By moving just the probing point ptp there is a single field line (and some other graphics element describing the field in ptp) that must be updated, while the heavier computation involved in creating the (many) general field lines need not be updated.

I finally had some time to complete my electric dipole simulation following the answers given and I'd like to say that now it works as expected and that the Manipulate code has been tamed with some wit (and without having to disassemble it).

Since I think that efficiently controlling the computations made in a Manipulate can be tricky and that really knowing the Dynamic and With commands and combining them in the proper way (as in the working solution) is not very easy (I'd never have found the way by myself), I've decided to summarize the final solution in the following fake code, just meant to highlight the code structure.

Probably the same structure can be easily adapted to other similar situations.

The core of the solution (suggested by Michel E2) is in two nested Dynamic[With[]]. The inner one is for the part that must not trigger a recalculation of the heavier general plots defined on the outer level (the code here below is just symbolic and won't actually work in a Mathematica Notebook):

Manipulate[LocatorPane[
  Dynamic[{q1p, q2p, ptp}],
  Dynamic[
   With[
    {
     fieldlines = (*fieldlines definition(q1p,q2p,qq1,qq2)*),
     fieldintplot = (*fieldintplot definition(q1p,q2p,qq1,qq2)*)
     },
    Dynamic[
     With[
      {
       fieldpoint = (*fieldpoint definition(q1p,q2p,qq1,qq2,ptp)*),
      },
      Show[fieldintplot, fieldlines, fieldpoint]
      ]
     ]
    ]
   ],(*LocatorPane-locators range->*){{xmin, ymin},{xmax,ymax}},
  (*LocatorPane - locators Appearance->*)
  Appearance -> {(*AppearanceDef*)}(*end of LocatorPane->*)],
 (*Empty controls of Manipulate - They are needed just for the \
initialization and the storage of the values for the controls already \
declared in the LocatorPane*)
{{q1p, {-2, 0}}, None}, {{q2p, {2, 0}}, None}, {{ptp, {-1.5, 2.5}}, None},
(*here goes the other active Manipulate controls*) 
 (*Other Manipulate Controls*), 
 Initialization :>
  (field[x_, y_, q1p_List, q2p_List, qq1_, qq2_] := (*field definition*);
  )
 ]

For completeness here is also the much longer (but working) code.

The main problem I had to face was in the generation of the field lines in the fieldlines StreamPlot. The default parameters of the StreamPlot tend to have uniformly spaced stream lines. But in many physics textbooks is often said that the field lines should have greater density where the field is stronger. So, to have the dipole field lines follow this rule, I set the StreamPoints in the following way.

In case of a dipole with equal signed charges the StremPoints are arranged around both the two charges, proportionally to the charges intensities.

In case of a dipole with opposite charges the StreamPoints are arranged around the stronger charge only. Anyway, since they must eventually end in the other charge (forward or backward depending on the sign of the stronger charge), some after a very long path, I had to set the StreamPlot range much more wider than the visible part. This made the plot rendering very heavy (despite Michael E2's code optimization) until I discovered the usefulness of the RegionFunction option.

Here's the full code:

Module[{field, fieldptsfunc, dirfun},
 Manipulate[LocatorPane[
   Dynamic[{q1p, q2p, ptp}],
   Dynamic[
    With[
     {
      fieldlines = 
       StreamPlot[
        field[x, y, q1p, q2p, qq1, qq2], {x, -frange, 
         frange}, {y, -frange, frange}, 
        StreamPoints -> {fieldptsfunc[q1p, q2p, qq1, qq2], 
          Automatic, {dirfun[qq1, qq2], l}},
        StreamScale -> {1/frange 5/20, 20, 0.008}, 
        StreamStyle -> RGBColor[0.2, 0.2, 0.2],
        StreamColorFunction -> 
         Function[Opacity[0.08 + 2/\[Pi] ArcTan[#5]]], 
        StreamColorFunctionScaling -> False, 
        RegionFunction -> 
         Function[{x, 
           y}, (x - q2p[[1]])^2 + (y - q2p[[2]])^2 >= d/
            4 && (x - q1p[[1]])^2 + (y - q1p[[2]])^2 >= d/4 && 
           Sqrt[x^2 + y^2] <= 5 Sqrt[2]]
        ],
      fieldintplot = 
       DensityPlot[(2/\[Pi] ArcTan[
           Norm[field[x, y, q1p, q2p, qq1, qq2]]])^
        ExCol, {x, -6, 6}, {y, -6, 6}, ColorFunction -> GrayLevel, 
        ColorFunctionScaling -> False, 
        BaseStyle -> Directive[Opacity[opac]], MaxRecursion -> 2, 
        PlotRange -> {0, 1.1}]
      },
     Dynamic[
      With[
       {
        fieldpoint = 
         StreamPlot[
          field[x, y, q1p, q2p, qq1, qq2], {x, -frangeline, 
           frangeline}, {y, -frangeline, frangeline}, 
          StreamPoints -> {{{ptp, {Thickness[0.005], 
               RGBColor[1, 0, 0], Arrowheads[0.02]}}}, 
            Automatic, {ForwardBackward, l}},
          StreamScale -> 1/(2 frangeline),

          StreamColorFunction -> 
           Function[Opacity[0.08 + 2/\[Pi] ArcTan[#5]]], 
          StreamColorFunctionScaling -> False, 
          RegionFunction -> 
           Function[{x, 
             y}, (x - q2p[[1]])^2 + (y - q2p[[2]])^2 >= d/
              4 && (x - q1p[[1]])^2 + (y - q1p[[2]])^2 >= d/4]],
        vecgraf = Graphics[
          With[
           {
            E1 = field[ptp[[1]], ptp[[2]], q1p, q2p, qq1, 0],
            E2 = field[ptp[[1]], ptp[[2]], q1p, q2p, 0, qq2],
            Ept = field[ptp[[1]], ptp[[2]], q1p, q2p, qq1, qq2]
            },
           {Opacity[0.85], 
            Text[Style[P, 22, RGBColor[0, 0, 0], Bold, Italic], 
             ptp, {0, 1.5}], 
            Text[Style[Subscript[q, 1], 22, RGBColor[0, 0, 0], Bold], 
             q1p, {0, 2}], 
            Text[Style[Subscript[q, 2], 22, RGBColor[0, 0, 0], Bold], 
             q2p, {0, 2}],

            Arrowheads[.015], {Dashed, GrayLevel[0.25], 
             Line[{{VS*E2[[1]] + ptp[[1]], 
                VS*E2[[2]] + ptp[[2]]}, {VS*Ept[[1]] + ptp[[1]], 
                VS*Ept[[2]] + ptp[[2]]}}]}, {Dashed, GrayLevel[0.25], 
             Line[{{VS*Ept[[1]] + ptp[[1]], 
                VS*Ept[[2]] + ptp[[2]]}, {VS*E1[[1]] + ptp[[1]], 
                VS*E1[[2]] + ptp[[2]]}}]},
            {RGBColor[0.2, 0.5, 0.2], 
             Opacity[
              1.2 - (1 Abs[qq2])/(Abs[qq1] + Abs[qq2] + 0.001)], 
             Disk[q1p, 0.2]}, {RGBColor[0.2, 0.2, 0.5], 
             Opacity[
              1.2 - (1 Abs[qq1])/(Abs[qq1] + Abs[qq2] + 0.001)], 
             Disk[q2p, 0.2]},
            {RGBColor[0.8, 0.0, 0.0], Disk[ptp, .12]},
            {Thickness[0.0025], RGBColor[0, 0.5, 0], 
             Arrow[{ptp, {VS*E1[[1]] + ptp[[1]], 
                VS*E1[[2]] + ptp[[2]]}}]},
            {Thickness[0.0025], RGBColor[0, 0, 0.5], 
             Arrow[{ptp, {VS*E2[[1]] + ptp[[1]], 
                VS*E2[[2]] + ptp[[2]]}}]},
            {Thickness[0.004], RGBColor[0.5, 0.1, 0.1], 
             Arrowheads[0.024], 
             Arrow[{ptp, {VS*Ept[[1]] + ptp[[1]], 
                VS*Ept[[2]] + ptp[[2]]}}]}}
           ]
          ]
        },
       Show[fieldintplot, fieldlines, fieldpoint, vecgraf,
        ImageSize -> 750, PlotRange -> {{-5, 5}, {-5, 5}}, 
        Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.012}], 
        AxesLabel -> {Style["x", Italic], Style["y", Italic]}, 
        Frame -> True, GridLines -> Automatic, 
        GridLinesStyle -> Directive[Black, Thin], 
        BaseStyle -> Directive[Opacity[opac]]]
       ]
      ]
     ]
    ],(*LocatorPane - locators range->*){{-4, -4}, {4, 4}},
   (*LocatorPane - locators Appearance->*)
   Appearance -> {Graphics[Locator[Appearance -> Medium]], 
     Graphics[Locator[Appearance -> Medium]], 
     Graphics[Locator[Appearance -> Medium]]}(*end of LocatorPane->*)],
  {{q1p, {-2, 0}}, None}, {{q2p, {2, 0}}, None}, {{ptp, {-0.5, 2.8}}, 
   None}, {{dir, Forward}, None},
  {{l, 400, Style["length", 12]}, 0, 1200, 1, Appearance -> "Labeled",
    None},
  {{frange, 200, Style["field range (frange)", 12]}, 5, 800, 5, 
   Appearance -> "Labeled", 
   None}, {{frangeline, 15, 
    Style["field range line(frangeline)", 12]}, 1, 200, 1, 
   Appearance -> "Labeled", None},
  {{d, 0.10 EuclideanDistance[q1p, q2p], 
    Style["field lines distance (d)", 12]}, 0, 
   1/2 EuclideanDistance[q1p, q2p], 0.1, Appearance -> "Labeled", 
   None},
  (*here goes the slider controls*)
  TabView[{"Field parameters" -> 
     Column[{Control[{{qq1, 2, 
          Style["\!\(\*SubscriptBox[\(q\), \(1\)]\)", 12]}, -4, 4, 
         0.1, Appearance -> "Labeled"}], 
       Control[{{qq2, -2, 
          Style["\!\(\*SubscriptBox[\(q\), \(2\)]\)", 12]}, -4, 4, 
         0.1, Appearance -> "Labeled"}], 
       Control[{{VS, 6, "Vector scale"}, 0, 25, 1, 
         Appearance -> "Labeled"}],
       Control[{{s, 20, Style["Field line density", 12]}, 0, 36, 1, 
         Appearance -> "Labeled"}]
       }],
    "Color parameters" -> 
     Column[{Control[{{ExCol, 0.3, "Color Scale"}, 0, 3, 0.1, 
         Appearance -> "Labeled"}], 
       Control[{{opac, 0.6, "Field background opacity"}, 0, 1, 0.1, 
         Appearance -> "Labeled"}]}]
    }
   ],
  Initialization :> (
    field[x_, y_, q1p_List, q2p_List, qq1_, 
      qq2_] := {(qq1 (x - q1p[[1]]))/
       EuclideanDistance[q1p, {x, y}]^3 + (qq2 (x - q2p[[1]]))/
       EuclideanDistance[q2p, {x, y}]^3, (qq1 (y - q1p[[2]]))/
       EuclideanDistance[q1p, {x, y}]^3 + (qq2 (y - q2p[[2]]))/
       EuclideanDistance[q2p, {x, y}]^3};
    dirfun[qq1_, qq2_] := 
     If[Chop[qq1 + qq2] == 0, 
      If[qq1 >= 0, Forward, Backward], 
      If[qq1 + qq2 > 0, Forward, Backward]];
    fieldptsfunc[q1p_List, q2p_List, qq1_, qq2_] :=
     Module[{\[Alpha]q, xqmax, yqmax, extrapt, s1, s2, tabqopp, 
       tabqconc},
      \[Alpha]q = 
       N[ArcTan[(q2p[[2]] - q1p[[2]])/(q2p[[1]] - q1p[[1]])]];
      xqmax = If[Abs[qq2] > Abs[qq1], q2p[[1]], q1p[[1]]];
      yqmax = If[Abs[qq2] > Abs[qq1], q2p[[2]], q1p[[2]]];
      extrapt = 
       If[Abs[qq2] > Abs[qq1], {q1p[[1]] - 25 d Cos[\[Alpha]q], 
         q1p[[2]] - 25 d Sin[\[Alpha]q]}, {q2p[[1]] + 
          25 d Cos[\[Alpha]q], q2p[[2]] + 25 d Sin[\[Alpha]q]}];
      s1 = If[qq1 == 0, 1, Round[Abs[qq1]/(Abs[qq1] + Abs[qq2]) s]];
      s2 = If[qq2 == 0, 1, Round[Abs[qq2]/(Abs[qq1] + Abs[qq2]) s]];
      (* if opposite charges *)
      tabqopp = 
       Join[Table[{xqmax + d Cos[k (2 \[Pi])/s + \[Alpha]q], 
          yqmax + d Sin[k (2 \[Pi])/s + \[Alpha]q]}, {k, 0, s - 1, 
          1}], {extrapt}];
      (* if equally signed charges *)
      tabqconc = 
       Join[Table[{q1p[[1]] + d Cos[k (2 \[Pi])/s1 + \[Alpha]q], 
          q1p[[2]] + d Sin[k (2 \[Pi])/s1 + \[Alpha]q]}, {k, 0, 
          s1 - 1, 1}], 
        Table[{q2p[[1]] - d Cos[k (2 \[Pi])/s2 + \[Alpha]q], 
          q2p[[2]] - d Sin[k (2 \[Pi])/s2 + \[Alpha]q]}, {k, 0, 
          s2 - 1, 1 }]];
      (*output of fieldptsfunc*)
      If[qq1*qq2 <= 0, tabqopp, tabqconc]
      ];
    )
  ]
 ]
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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