2
$\begingroup$

I wanted to create a set of points (a,b) such that a, b are both integers between -6 and 6. Then I want to color all points (a,b) that satisfy $|a-b|\ge2$ red, and all the remaining points blue. I tried:

A = Table[{a, b}, {a, -6, 6}, {b, -6, 6}];
ListPlot[A,
 ColorFunction -> Function[{x, y}, If[Abs[x - y] >= 2, Red, Blue]]]

But that did not work. Any suggestions?

$\endgroup$
1
  • $\begingroup$ ColorFunction requires your data set to be joined $\endgroup$ Jan 7 '16 at 0:58
2
$\begingroup$
A = Flatten[
   Table[Style[{a, b}, If[Abs[a - b] >= 2, Red, Blue]], {a, -6, 
     6}, {b, -6, 6}], 1];
ListPlot[A]

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ Wow, styling before plotting. Nice idea. $\endgroup$
    – David
    Jan 7 '16 at 1:36
2
$\begingroup$

You can style the points before you plot (Zviovich's solution) or when you plot (see below).

A = Table[{a, b}, {a, -6, 6}, {b, -6, 6}];
ListPlot[MapAt[
   Style[#, If[Abs[First@# - Last@#] >= 2, Red, Blue]] &, {All, All}]@A]

Mathematica graphics

Hope this helps.

$\endgroup$
2
$\begingroup$

Alternatives methods for you to use have been posted but the reason your attempt fails is that ColorFunction requires your data to be joined. e.g

enter image description here

versus:

enter image description here

$\endgroup$
2
  • $\begingroup$ Cool. I appreciate these kinds of explanations. I didn't get the diagonal lines though, as mine were all vertical. I also added this at the end, /.Line->Point and got the points back. $\endgroup$
    – David
    Jan 7 '16 at 1:33
  • 1
    $\begingroup$ @David I flattened your data to the next level $\endgroup$ Jan 7 '16 at 2:03
2
$\begingroup$

An alternative is BubbleChart

BubbleChart[
 Table[{a, b, 1}, {a, -6, 6}, {b, -6, 6}],
 ColorFunction -> Function[{a, b}, If[Abs[a - b] >= 2, Red, Blue]],
 ColorFunctionScaling -> False]

enter image description here

$\endgroup$
1
$\begingroup$

Use an empty Plot to generate all your axes and then overlay all your colored points.

Show[
  Plot[0, {x, -6, 6}, PlotRange -> {{-6.5, 6.5}, {-6.5, 6.5}}],
  Graphics[Table[{If[Abs[a-b]>=2, Red, Blue], Point[{a,b}]}, {a,-6,6},{b,-6,6}]]
]

points

$\endgroup$
2
  • 1
    $\begingroup$ Why not just Graphics[Table[{If[Abs[a - b] >= 2, Red, Blue], Point[{a, b}]}, {a, -6, 6}, {b, -6, 6}], PlotRange -> {{-6.5, 6.5}, {-6.5, 6.5}}, Axes -> True]??? $\endgroup$ Jan 7 '16 at 1:08
  • $\begingroup$ @Mike Honeychurch Some languages have one clear way of writing almost anything. Someone wrote "In Mathematica there are at least a dozen different ways of writing anything, at least three of which are completely incomprehensible." It doesn't seem clear that there is a significant difference in the top half dozen ways of writing something in Mathematica, other than culture and style preference. $\endgroup$
    – Bill
    Jan 7 '16 at 2:56
1
$\begingroup$

Here are a couple of ways. I will set them up to be applied to a flat list of points. The OP's points in A can be put in this form by

pts = Flatten[A, 1]

or more directly constructed with

pts = Tuples[Range[-6, 6], 2]

Separate into two data sets

Use GatherBy with a functional version of the condition. Note that the order returned by GatherBy is not guaranteed, so some inspection is needed to see which list in data is the red set of points. (The order is not random but depends on pts; however, I am presenting code that does not rely on knowledge of the internal ordering of pts.)

cond[{x_, y_}] := Abs[x - y] >= 2;
data = GatherBy[pts, cond];
style = If[cond@data[[1, 1]], {Red, Blue}, {Blue, Red}];
ListPlot[data, PlotStyle -> style]

High efficiency

The above is pretty efficient, and ListPlot has the MaxPlotPoints option for downsampling large sets of points. But if you want to deal with all points, a vectorized approach should help. We have to do the standard trick of translating the inequality into terms of UnitStep (c.f. point 2.3 of Performance tuning in Mathematica?).

pts = Tuples[Range[-6, 6], 2];
colfn = Compile[{{i, _Integer, 1}}, {{1., 0., 0.}, {0., 0., 1}}[[i]]];
col = colfn[1 + (UnitStep[Abs[#1 - #2] - 2] & @@ Transpose[pts])];
Graphics[{PointSize[Large], Point[pts, VertexColors -> col]}, 
 FilterRules[Options[ListPlot], Options[Graphics]]]

Mathematica graphics

Note that in V10 (at least in 10.3), we don't have to filter Options[ListPlot] for Graphics; we may pass Options[ListPlot] directly and it is taken care of for us.

To give an idea how to start translating an inequality into terms of UnitStep, here is an color function generator for a simple (single) inequality:

Clear[x, y, makeColFn];
(*
  ineq : single, simple inequality in terms of x, y;
  colors : {False color, True color}
*)
makeColFn[ineq : (Less | LessEqual | Greater | GreaterEqual)[_, _], colors_] :=
  Compile @@ Block[{Part, pts},
    With[{parts = Replace[ineq,
         {Less[l_, r_] :> 2 - UnitStep[l - r],
          LessEqual[l_, r_] :> 1 + UnitStep[r - l],
          GreaterEqual[l_, r_] :> 1 + UnitStep[l - r],
          Greater[l_, r_] :> 2 - UnitStep[r - l]}
         ] /. {x -> pts[[All, 1]], y -> pts[[All, 2]]},
      colorvec = N@colors /. RGBColor -> List},
     Hold[{{pts, _Real, 2}}, colorvec[[parts]]]
     ]
    ];

Note that 1 had to be added to the usual 0/1 output in order to get valid Part numbers. Normally, one deals with 0/1 expressions, for example 1 - UnitStep[l - r] instead of 2 - UnitStep[l - r]. For such expressions, complicated combinations of inequalities can be handled using multiplication for And and addition (perhaps in combination with Unitize) for Or; sometimes ingenuity can help, too. :)

Example (medium-sized data):

pts = RandomReal[{-6, 6}, {10000, 2}];
col = makeColFn[Abs[x - y] >= 2, {Blue, Red}][pts];
Graphics[{Point[pts, VertexColors -> col]},
 FilterRules[Options[ListPlot], Options[Graphics]]]

Mathematica graphics

$\endgroup$

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.