8
$\begingroup$ 
ContourPlot[
 EuclideanDistance[{-5, 0}, {x, y}]*
  EuclideanDistance[{5, 0}, {x, y}], {x, -15, 15}, {y, -11, 11}, 
 Contours -> Range[5, 150, 20], Frame -> False, 
 ContourLabels -> (Text[Style[#3, Directive[Blue, 15]], {#1, #2}] &), 
 AspectRatio -> Automatic, 
 ColorFunction -> (If[# < 145, 
     ColorData[{"TemperatureMap", {0, 145}}, #], None] &), 
 ColorFunctionScaling -> False]

enter image description here

How to remove those redundant 25? I just hope to keep one or two. But I get a ton of label 25, which makes the graphic look crowded...

Improve this question
$\endgroup$
2
  • $\begingroup$ adding the option MaxRecursion -> 1 seems to get rid of multiple labels. $\endgroup$
    – kglr
    Jan 18 at 19:32
  • $\begingroup$ PlotPoints -> 75 reduces the 25 labels to three widely-separated labels and provides a smooth plot. $\endgroup$
    – Bob Hanlon
    Jan 18 at 19:39

3 Answers 3

Reset to default
6
$\begingroup$

Simplifying and evaluating the argument will also reduce the redundant labels.

$Version

(* "13.0.0 for Mac OS X x86 (64-bit) (December 3, 2021)" *)

ContourPlot[
 Evaluate[
  Simplify[
   EuclideanDistance[{-5, 0}, {x, y}]*
    EuclideanDistance[{5, 0}, {x, y}]]],
 {x, -15, 15}, {y, -11, 11},
 Contours -> Range[5, 150, 20],
 Frame -> False,
 ContourLabels ->
  (Text[Style[#3, Directive[Blue, 15]], {#1, #2}] &),
 AspectRatio -> Automatic,
 ColorFunction ->
  (If[# < 145, ColorData[{"TemperatureMap", {0, 145}}, #], 
     None] &),
 ColorFunctionScaling -> False]

enter image description here

Improve this answer
$\endgroup$
11
$\begingroup$ 
cp = ContourPlot[EuclideanDistance[{-5, 0}, {x, y}] EuclideanDistance[{5, 0}, {x, y}], 
  {x, -15, 15}, {y, -11, 11}, 
  Contours -> Range[5, 150, 20], Frame -> False, 
  ContourLabels -> (Text[Style[#3, Directive[Blue, 15]], {#1, #2}] &),
  AspectRatio -> Automatic, 
  ColorFunction -> (If[# < 145, ColorData[{"TemperatureMap", {0, 145}}, #], None] &), 
  ColorFunctionScaling -> False]

enter image description here

You can post-process cp to remove duplicate labels:

ReplaceAll[labels : {__Text} :> DeleteDuplicatesBy[First] @ labels] @ cp

enter image description here

Alternatively, you can add the option

DisplayFunction -> ReplaceAll[labels : {__Text} :> DeleteDuplicatesBy[First] @ labels]

to ContourPlot[...] to get the same picture.

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks very much $\endgroup$
    – yode
    Jan 19 at 4:10
3
$\begingroup$

Follow the approach by @Bob Hanlon.

I think the problem come from the Complex Function EuclideanDistance since it contain Sqrt and Abs.

EuclideanDistance[{a, b}, {x, y}]
(* Sqrt[Abs[a - x]^2 + Abs[b - y]^2] *)

So sometimes I avoid to use EuclideanDistance or Norm. Here we can use #.#& instead.

Sqrt[# . # &[{-5, 0} - {x, y}] # . # &[{5, 0} - {x, y}]]

Or

Sqrt[Norm[{-5, 0} - {x, y}]^2 Norm[{5, 0} - {x, y}]^2]

Or

Sqrt[EuclideanDistance[{-5, 0}, {x, y}]^2 EuclideanDistance[{5, 
   0}, {x, y}]^2]
Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks a lot... $\endgroup$
    – yode
    Jan 19 at 4:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.