0
$\begingroup$

A simple question but the answer is elusive... well, for me anyway!

Given a metric space defined as d((x1,x2),(y1,y2)) == 4|y1 - x1| + d0(x2,y2), how can I plot open Bd((0,0),1) with Mathematica?

Henrik Schumacher has been a great help here suggesting the metric would be f = Function[{x, y}, 4 Abs[Indexed[x, 1] - Indexed[y, 1]] + Unitize[Indexed[x, 2] - Indexed[y, 2]]], however I've had no luck with any attempt at producing a plot. I just get an empty grid.

Can anyone help with the relevant code needed to produce a plot?

Wolfram has an explanation here: mathworld.wolfram.com/DiscreteMetric.html. Briefly, if the two points are the same point, d0 is zero otherwise d0 is 1. – Davo Commented Mar 18, 2022 at 22:52

Improve this question
$\endgroup$
1
  • $\begingroup$ Wolfram has an explanation here: mathworld.wolfram.com/DiscreteMetric.html. Briefly, if the two points are the same point, d0 is zero otherwise d0 is 1. $\endgroup$ Commented Mar 18, 2022 at 22:52

2 Answers 2

Reset to default
0
$\begingroup$

If I understand correctly, you define a distance function of:

dist[p1_, p2_] := 
  4 Abs[p1[[1]] - p2[[1]]] + If[p1[[2]] == p2[[2]], 0, 1];

A ball with this metric are all points that fulfill the equation:

dist[{x, y}, {0, 0}] == 1

We may solve this by:

Reduce[dist[{x, y}, {0, 0}] == 1, {x, y}, Reals]

enter image description here

This means: if y!=0 then x==0, that is the y axis without the origin. And if y==0 then x==+/- 1/4. A plot of these points looks like:

Graphics[{Red, Thickness[0.005], InfiniteLine[{{0, -1/4}, {0, 1/4}}], 
  Point[{{-1/4, 0}, {1/4, 0}}], Black, Point[{0, 0}]}, Axes -> True, 
 PlotRange -> {0.5 {-1, 1}, 0.5 {-1, 1}}]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Daniel, many thanks for this. Two questions, if I may. 1) How did you get the {{x -> 0 if y > 0 || y < 0 }, etc} to print? 2) I note that you have InfiniteLine with 0 to -1/4 and 0 to 1/4 however it seems InfiniteLine has possibly 'overruled' the 0 to -1/4 and 0 to 1/4. Should InfiniteLine be just Line? $\endgroup$ Commented Mar 19, 2022 at 17:40
  • $\begingroup$ 1) if a statement has no ";" at the end, it will print its output. ";" will prevent this. 2) InfiniteLine[{{0, -1/4}, {0, 1/4}}] means an infinite line passing though points: {0, -1/4}, and {0, 1/4} For the graphics, you may as well use an ordinary line : Line[..] $\endgroup$ Commented Mar 19, 2022 at 17:48
  • $\begingroup$ Got it! Many thanks, Daniel. Greatly appreciated. $\endgroup$ Commented Mar 19, 2022 at 18:33
0
$\begingroup$

It's unclear what is desired. The plot has two "contours", better called by the alternate term, "level set" in this case: A single point, the center, (level = distance of zero); and everything else but the center (level = distance of one). This holds for ${\Bbb R}^n$, for any dimension $n>0$. "Continuous" plotters like ContourPlot[] won't plot single points. With discrete sampling, there's a good chance that the one point excluded in level 1, the center, will be missed unless care is taken to ensure that the center is one of the sample points.

According to the MathWorld article cited by the OP in a comment, the metric is not the function the OP include but simply the following:

dd = Function[{x, y}, Boole[x != y]];

Here are two approaches to approximating the level sets, with two alternatives for legending determined by the Contours option.

dd = Function[{x, y}, Boole[x != y]];
center = {Pi, Sqrt[2]};
domain = center + {{-2, 2}, {-2, 2}};
ContourPlot[dd[{x, y}, center]
 , {x, Sequence @@ First@domain}, {y, Sequence @@ Last@domain}
 , Contours -> {0, 1}, Exclusions -> None, MaxRecursion -> 6, 
 PlotLegends -> Automatic]

contour plot with dot in center

dd = Function[{x, y}, Boole[x != y]];
center = {1, 1};
domain = center + {{-2, 2}, {-2, 2}};
sampling = 
  Outer[List, Subdivide[Sequence @@ First@domain, 100], 
   Subdivide[Sequence @@ Last@domain, 100]];
ListContourPlot[Map[dd[#, center] &, sampling, {2}], 
 DataRange -> domain, Contours -> 1, PlotLegends -> Automatic]

contour plot with dot in center

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.