3
$\begingroup$

Suppose that I have the following ellipse function,

$f(x,y)=4x^2+y^2-5$.

The gradient of this ellipse is calculated as

$\nabla f(x,y)=[8x,2y]$.

I know how to plot and join them. It is easy. I do the following,

P1 = ContourPlot[4 x^2 + y^2 == 5 , {x, -3, 3}, {y, -3, 3}, 
  AspectRatio -> Automatic]
P2 = VectorPlot[{8 x, 2 y}, {x, -3, 3}, {y, -3, 3}]
Show[P1, P2]

This gives me the following.

ellipse function and its gradient

But, What I would like to do is to see the gradient vectors only on the perimeter of my ellipse not everywhere. I tried to reduce the range of the variables in VectorPlot but it doesn't help. Does anyone have a suggestion?

$\endgroup$
  • 1
    $\begingroup$ Something like P2 = VectorPlot[If[4 x^2 + y^2 <= 5, {8 x, 2 y}, {0, 0}], {x, -3, 3}, {y, -3, 3}] ? $\endgroup$ – ctrl Sep 28 '18 at 13:30
  • $\begingroup$ Thanks for your answer. But I want it just on the outer surface of the ellipse, in other words on its perimeter $\endgroup$ – KratosMath Sep 28 '18 at 13:31
  • $\begingroup$ You could draw you own arrows like this: Show[Graphics[Table[Arrow[{{xPos[t], yPos[t]}, {xPos[t], yPos[t]} + .05 {8 xPos[t], 2 yPos[t]}}], {t,0, 2 Pi, .1}]], P1] $\endgroup$ – ctrl Sep 28 '18 at 13:52
2
$\begingroup$

Utilizing this post for creating Evenly spaced points on boundary of polygon, we can do this as follows:

f = {x, y} \[Function] 4 x^2 + y^2;
gradf = {x, y} \[Function] Evaluate[D[f[x, y], {{x, y}, 1}]];
P1 = ContourPlot[f[x, y] == 5, {x, -3, 3}, {y, -3, 3}];

numarrows = 100;

(*extracting the coordinates from the ContourPlot*)    
pts = Cases[P1, _GraphicsComplex, ∞][[1, 1]];

(*creating evenly distributed points on the ContourPlot (does only work for a single closed contour!)*)
t = Prepend[Accumulate[Norm /@ Differences[pts]], 0.];
γ = Interpolation[Transpose[{t, pts}], InterpolationOrder -> 1, PeriodicInterpolation -> True];
s = Subdivide[γ[[1, 1, 1]], γ[[1, 1, 2]], numarrows];
newpts = γ[s];

(*plotting the scaled gradients*)
scale = 0.1;
P2 = Graphics[ Arrow[Most@Transpose[{newpts, newpts + scale gradf @@@ newpts}]]];

Show[P1, P2]

enter image description here

$\endgroup$
  • $\begingroup$ very nice answer with a very nice explanation. Thanks $\endgroup$ – KratosMath Sep 28 '18 at 14:29
  • $\begingroup$ You're welcome! $\endgroup$ – Henrik Schumacher Sep 28 '18 at 14:29
  • $\begingroup$ @HenrikSchumacher In your Cases[P1, _GraphicsComplex, All] should the All be an Infinity? $\endgroup$ – That Gravity Guy Sep 28 '18 at 18:24
  • $\begingroup$ @ThatGravityGuy Yeah maybe. As of version 11.3, All does also work. $\endgroup$ – Henrik Schumacher Sep 28 '18 at 18:25
  • $\begingroup$ Ah. I work in 8.0 and 10.1. Though the online documentation doesn't seem to say it has that functionality yet. Just the Infinity level specification. $\endgroup$ – That Gravity Guy Sep 28 '18 at 20:08
3
$\begingroup$
ClearAll[gradF, f]
gradF[f_] := Grad[f[x, y], {x, y}] /. Thread[{x, y} -> {##}] &; 
f[x_, y_] := 4 x^2 + y^2 -5
n = 100; length = .1; c = 0;

Use "ArcLength" as MeshFunctions and post-process points into arrows:

Normal[ContourPlot[f[x, y] == c , {x, -3, 3}, {y, -3, 3}, 
   MeshFunctions -> { "ArcLength"}, Mesh -> {Range[0, 1 - 1/n, 1/n]}] ] /. 
 Point -> (Arrow[{#, # + length gradF[f] @@ #}] &) 

enter image description here

$\endgroup$

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.