Find lengths of contours in a ContourPlot

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

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?

• What is omega ? – b.gates.you.know.what 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

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


Then

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]


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} *)

• Works great, thanks so much! – pirtle Apr 21 '14 at 21:38