4
$\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$
3
  • 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, 2018 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, 2018 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, 2018 at 13:52

2 Answers 2

3
$\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$
5
  • $\begingroup$ very nice answer with a very nice explanation. Thanks $\endgroup$
    – KratosMath
    Sep 28, 2018 at 14:29
  • $\begingroup$ You're welcome! $\endgroup$ Sep 28, 2018 at 14:29
  • $\begingroup$ @HenrikSchumacher In your Cases[P1, _GraphicsComplex, All] should the All be an Infinity? $\endgroup$ Sep 28, 2018 at 18:24
  • $\begingroup$ @ThatGravityGuy Yeah maybe. As of version 11.3, All does also work. $\endgroup$ Sep 28, 2018 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$ Sep 28, 2018 at 20:08
4
$\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$
1
  • $\begingroup$ This method does not work anymore at least since Mathematica 11.3. See this question. Is there any way to make this method work in the latest version of Mathematica? An alternative would be to extract the points (not spaced equidistant), make an interpolating parametric curve, and then use the same method with ParametricPlot. $\endgroup$
    – Praan
    Sep 22, 2022 at 14:47

Your Answer

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

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