Find lengths of contours in a ContourPlot

Question

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?

Answer 1

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]

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