Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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 at 7:11
2  
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 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 at 21:36
    
I've now added a question regarding finding areas between contours here. –  pirtle Apr 22 at 4:06
add comment

1 Answer 1

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

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]

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 at 21:38
add comment

Your Answer

 
discard

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.