Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

I am trying to find the lengths of different contours in the following plot:

ContourPlot of interest!!

It is a complicated piecewise function evaluated on the unit disk. I am hoping there is an easy, generalized way to numerically approximate each of the contours' lengths.

Essentially, I am looking for a way to solve for the length of a homogenous equation bound by a region. Given a function f(x,y) - f* == 0 on a region R, where f* is the value of the contour of interest, is there a way to find the length of the curve that satisfies that equation?

For concreteness, the above is the ContourPlot of

q[r_] := Piecewise[{{25/(0.1*1), r < 0.1}, {25/r, r >= 0.1}}]
phi[r_, t_] := (Pi/2) + q[r]*t
v[r_, t_] := q[r]*r*Cos[phi[r, t]]
s[x_] := Piecewise[{{x = -1, x < 0}, {x = 1, x >= 0}}]

f[x_,y_] := s[x]*v[Sqrt[x^2 + y^2],ArcTan[y/x]/q[Sqrt[x^2 + y^2]]]

How does one numerically find the lengths of each of those contours?

share|improve this question
What is omega ? – b.gatessucks Apr 19 '14 at 7:11
start by doing Cases[ContourPlot[...],Line[pts_]:>List[pts],Infinity]. Use ListPlot to verify the extracted lists are your contours. It is then a simple matter to find the length of the line. – george2079 Apr 19 '14 at 13:11
Sorry, the omega was a typo resulting from poor copy/pasting, I've changed it to reflect the actual function. Thanks for the assistance, George! – pirtle Apr 21 '14 at 21:36
I've now added a question regarding finding areas between contours here. – pirtle Apr 22 '14 at 4:06
up vote 4 down vote accepted

How about

pl = ContourPlot[f[x, y], {x, -1, 1}, {y, -1, 1}, 
 RegionFunction -> Function[{x, y}, x^2 + y^2 < 1], PlotPoints -> 25,ContourShading -> False]

Mathematica graphics


lines = Cases[pl // Normal, Line[pts_] :> List[pts], Infinity];
lines = Select[lines, Length[#[[1]]] > 20 &];
lines = Map[Flatten[Transpose[#], 1] &, lines];

Picking up the first segment;

 l1 = lines[[1]]; ListLinePlot[l1]

Mathematica graphics

So that the Length is just

 pts = (l1 - RotateLeft[l1] // Most);
 Total@ Map[Norm, pts]

(* 1.91 *)

If you want all lengths, then loop

  Table[l1 = lines[[i]];pts = (l1 - RotateLeft[l1] // Most);Total@ Map[Norm, pts],
       {i, Length[lines] - 1}]

(* {1.91801,1.9595,1.98317,1.99609,1.9987,1.99605,1.9832,1.95951,1.91821} *)

share|improve this answer
Works great, thanks so much! – pirtle Apr 21 '14 at 21:38

Your Answer


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.