[Date Index]
[Thread Index]
[Author Index]
Contour plots with map style (rotated) labels
*To*: mathgroup at smc.vnet.net
*Subject*: [mg102765] Contour plots with map style (rotated) labels
*From*: Jens Noeckel <noeckel at gmail.com>
*Date*: Wed, 26 Aug 2009 07:45:12 -0400 (EDT)
*References*: <c1a8326f-e0b4-4e6b-a8da-9b124861c2a8@z31g2000yqd.googlegroups.com>
Hi Steve,
thanks for notifying us of the Google Groups posting problems. I guess
I was affected by that, as I haven't seen my last two posts appear on
the list. Here is one that I kept a record of, and that I think is
worth re-posting. It's a function to align contour labels tangentially
to the contours in ContourPlot. It searches for two points on a
contour line closest to each label, and applies a rotation to the
label based on the direction defined by those two points. These
searches rely on two applications of Nearest for each label: one to
find the nearest contour, and a second one to find the nearest points
on that contour. The first of these searches could be eliminated to
make the function faster if I were able to assume that contour lines
and contour labels are always sorted in an identical order in the
output GraphicsComplex. However, I wasn't sure that that's always
true, so I went with a slightly more laborious approach.
Regards,
Jens
Begin forwarded message:
> From: JUN <noeckel at gmail.com>
> Date: August 18, 2009 8:56:31 AM PDT
> To: noeckel at gmail.com
> Subject: Contour plots with map style (rotated) labels
>
> Hi,
> someone asked me about this, and there was some discussion earlier:
> http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/6dcd75efd2f99f09
>
> For ContourPlot and ListContourPlot, it's sometimes nice to have
> labels rotated to be parallel to the iso-lines. So I made a function
> "rotateContourLabels" which post-processes Mathematica's contour plots
> to achieve this rotation, and am pasting the code below.
>
> As an example, try these plots:
>
> a = ContourPlot[Im[(x + I y)^(1/2)], {x, -1, 1}, {y, -1, 1},
> Contours -> 20, ContourLabels -> All]
>
> b = ListContourPlot[Table[Sin[i+j^2],{i,0,3,0.1},{j,0,3,0.1}],\
> ContourLabels->All]
>
> Note that for the post-processing to work, you must set the option
> ContourLabels->All as shown above (I am not modifying the default
> plotting functions, just processing their output, so I have to make
> some assumptions about how contour labels appear in the output). The
> next step is to do call
> rotateContourLabels[a,Text[#3, {#1, #2}, Background -> White] &]
> rotateContourLabels[b,{Orange, Text[#3, {#1, #2}]} &]
>
> The second argument is optional - it's a function to style the plot
> labels (see documentation for ContourLabels for usage of the
> function).
>
> Hope someone finds this useful or sees a way to improve it. For
> example, one could change this into a replacement for ContourPlot
> which accepts all the Options and creates the plot from scratch. One
> of Mathematica's competitor products has this label rotation built in,
> and even allows interactive placement. That could be done here using
> Tooltip as well, but I didn't think it's worth the trouble...
>
> Here is the code (the comments take up more space than the actual
> program).
>
> Cheers,
> Jens
>
>
> rotateContourLabels::usage = "The function rotateContourLabels \
> accepts the output of ContourPlot or ListContourPlot, assuming they \
> were made with the option ContourLabel-> All. The plot is passed via \
> the required first argument. The function rotates the labels of all \
> contours to be approximately parallel to the iso-lines. An optional \
> second argument can specify a custom label style in the form of a \
> function f[#1, #2, #3], where {#1, #2} is the 2D location vector of \
> the label, and #3 the value of the plotted function at that location.
> \
> For examples see the documentation on ContourLabels. The default \
> label style is given by the function Text[#3,{#1,#2}]&.";
>
> rotateContourLabels[plot_, labelFunc_: (Text[#3, {#1, #2}] &)] :=
> Module[{gc = plot[[1]] , pointList, rotatePoint,
> labelCoordinatesIndexed},
> Catch[
> labelCoordinatesIndexed =
> Quiet@Check[gc[[-1, -1, All, 2]], Throw[plot]];
> valueList = Quiet@Check[gc[[-1, -1, All, 1]], Throw[plot]];
> pointList =
> Quiet@Check[gc[[1, labelCoordinatesIndexed]],
> Throw[{"The plot must have the option ContourLabels->All !!!",
> plot}]];
> (** gc is the GraphicComplex, gc[[1]] a list of 2D points.
> The list of contour labels is contained in plot[[1,-1,-1]] =
> gc[[-1,-1]] and we want to replace this list. **)
>
> (* Local function definition: *)
>
> rotatePoint[pt_] :=
> Module[{extractSecant , allContourLines, contourPoints2D,
> contourPointsIndexed , closestContourIndexed,
> closestPointIndexed},
> allContourLines =
> Map[First,(**
> The First extracts the list of line points from the Line \
> expressions collected in the next line: **)
>
> Cases[Flatten@
> MapAll[If[SameQ[Head[#], Line], #, Apply[List, #]] &,
> gc[[-1]]], _Line]];
> (** Line can be nested inside other non-
> list expressions such as Tooltip,
> so the above flattens all levels of the expression except for \
> subexpressions with head Line,
> before it proceeds to collect the Lines using Cases. **)
>
> {contourPoints2D, contourPointsIndexed} =
> (** Given a point pt,
> find out for each contour what is its closest point to pt.
> Return this information both as 2D points and as a list of \
> indices counted within each contour. **)
> Transpose[
> Map[
> First@Nearest[
> # -> Transpose[{#, Range[Length[#]]}],
> pt
> ] (** End First@Nearest **)&,
> Map[gc[[1, #]] &, allContourLines]
> ](* End Map *)
> ] (* End Transpose *);
>
> {closestContourIndexed, closestPointIndexed} =
> (** Given a point pt, find closest contour.
> Give its index in the list of contours,
> and the index of the closest point within this contour. **)
>
> First[Nearest[
> contourPoints2D ->
> Transpose[{Range[Length[contourPoints2D]],
> contourPointsIndexed}],
> pt
> ]];(* End First@Nearest *)
>
> extractSecant = (** Given the closest point to pt,
> record it and its next neighbor on the same contour line.
> The two points are reutrned as real 2D points,
> determined from their indices. **)
> {
> allContourLines[[closestContourIndexed, closestPointIndexed]]
> (*
> The first point *),
> Quiet@
> Check[allContourLines[[closestContourIndexed,
> closestPointIndexed + 1]],
> allContourLines[[closestContourIndexed,
> closestPointIndexed - 1]]] (* The second sequential point -
> here I want to avoid falling outside the range of the contour \
> point list. *)
> };
>
> (* The rotation aims to make this vector parallel to the \
> contour. We approximate the contour direction by taking two points on
> \
> the contour and forming their difference: *)
>
> directionVector = Apply[Subtract,
> (** The two required points are found from the list gc[[1]] :
> **)
>
> Part[gc[[1]],
> (* The Part of gc[[
> 1]] we're looking for is a set of two points that define the \
> secant closest to the contour label: *)
> extractSecant]
> ];
>
> (** Here starts the body of rotatePoint: **)
> Composition[
> (* The composition sandwiches a rotation around the origin \
> between a translation to the origin and its inverse: *)
>
> TranslationTransform[pt],
> Quiet@Check[RotationTransform[{
> {1, 0}, (*
> The reference direction for the rotation is the horizontal:
> \
> *)
> (Sign[directionVector[[1]]] directionVector)
> (*
> To avoid rotations outside [-\[Pi],\[Pi]] the above \
> statement places the direction vector into the first or fourth \
> quadrant. *)
> }] (* End RotationTransform *)
> , Identity (*
> No rotation happens if for some reason we can't get a valid \
> direction vector *)],
> TranslationTransform[-pt]
> ] (* End Composition *)
> ] ;(** End function rotatePoint **)
>
> (**** Main function body: *****)
>
> ReplacePart[plot, {1, -1, -1} ->
> (** the replacement is a geometric transformation of the \
> original list gc[[-1,-1]]: **)
>
> MapThread[GeometricTransformation,
> {MapThread[labelFunc, Append[Transpose[pointList], valueList]],
> (**
> What follows is the list of transformations for each contour \
> label: **)
> Map[rotatePoint, pointList]}]]
> ]]
>
Prev by Date:
**Re: Re: Viewing packages in mathematica**
Next by Date:
**Re: Mathematica 7.0.0 running on Mac OSX Snow Leopard ?**
Previous by thread:
**Re: InverseFunction of a CDF**
Next by thread:
**Problems with functions of a Complex Variable**
| |