2
$\begingroup$

Let's create some random data

Clear["Global`*"];

n = 10^4;
Nmax = 10000;
data = Table[{RandomReal[{-1, 1}], RandomReal[{-1, 1}], 
RandomInteger[{0, 500}]}, {i, 1, n}];

then the so-called Jet color function

jet[u_?NumericQ] := 
  Blend[{{0, RGBColor[0, 0, 9/16]}, {1/9, Blue}, {23/63, 
  Cyan}, {13/21, Yellow}, {47/63, Orange}, {55/63, Red}, {1, 
  RGBColor[1/2, 0, 0]}}, u] /; 0 <= u <= 1;

and finally plot the points, according to the value of the third column

Nmin = 100;
Nmax = 400;
valrange = {Nmin, Nmax};
data[[All, 3]] = Rescale[data[[All, 3]] // N, valrange];

colfunc[x_] := jet[x[[3]]];
g0 = Graphics[{PointSize[0.01], 
 Point[#[[1 ;; 2]], VertexColors -> colfunc[#]] & /@ data}]

enter image description here

As we can see, many of the points are plotted in black. This is because the third element of the list runs from 0 to 500, while after the rescale we color only those between 100 and 400.

I want the following: All points for which the third element in less than 100 should be in gray, while all points for which the third element is above 400 should be in darker red.

Any suggestions?

Improve this question
$\endgroup$
3
$\begingroup$

Rescale >> Details:

enter image description here

That is, the values below min are mapped to negative values `and those above max are mapped to values greater than 1.

So you can modify your colfunc to change the colors so that (1) if the rescaled value of the third column is negative we have a Gray point, (2) if the rescaled value of the third column is no less than 1 we have a Darker@Red point, else (3) the point is colored using jet:

colfunc[x_] := Piecewise[{{Gray, # <= 0}, {Darker@Red, # >= 1}}, jet @ #] &@x[[3]];

g0 = Graphics[{PointSize[0.01], Point[#[[1 ;; 2]], VertexColors -> colfunc[#]] & /@ data}]

enter image description here

Update: a more flexible approach that allows one to specify the thresholds for rescaling and re-coloring:

ClearAll[colfunc2]
colfunc2[t1_: {100, 400}, t2_: {100, 400}][x_] := 
  Piecewise[{{Gray, # <= Rescale[t1[[1]], t2]}, {Darker@Red, # >= 
        Rescale[t1[[2]], t2]}}, jet@#] &@x[[3]];

g0 = Graphics[{PointSize[0.01], Point[#[[1 ;; 2]],
   VertexColors -> colfunc2[][#]] & /@ data}]

enter image description here

g1 = Graphics[{PointSize[0.01], Point[#[[1 ;; 2]], 
    VertexColors -> colfunc2[{200, 250}][#]] & /@ data}]

enter image description here

Update 2:

assign a custom color (let's say magenta) to those for which the third element is between 200 and 250.

colfunc3[x_] :=  Piecewise[{{Gray, # <= 0}, {Darker@Red, # >= 1}, 
  {Magenta, Rescale[200, valrange] <= # <= Rescale[250, valrange]}}, jet@#] &@x[[3]]

Graphics[{PointSize[0.01], 
  Point[#[[1 ;; 2]], VertexColors -> colfunc3[#]] & /@ data}]

enter image description here

Improve this answer
$\endgroup$
6
  • $\begingroup$ Nice and elegant! Let's wait for a while (before accepting the answer), in case someone else wants to propose an alternative. $\endgroup$ – Vaggelis_Z Jan 3 '18 at 19:23
  • $\begingroup$ Just of curiosity: if we would like to plot all points for which the third element is between 200 and 250, what should be changed to the piecewise function? $\endgroup$ – Vaggelis_Z Jan 3 '18 at 19:27
  • $\begingroup$ If you want to completely strip out points I'd separately use select ( Select[data,200<#[[3]]<250&] ) rather than trying to make them transparent or something. $\endgroup$ – george2079 Jan 3 '18 at 19:37
  • $\begingroup$ @Vaggelis_Z, if mean to plot only points for which the third element is between 200 and 250 and drop the rest, then you can use Select[data, 200<= #[[3]]<=250&] or Pick[data, 200<= #[[3]]<=250&/@data] without making any chnges to the color function. Or, perhaps, modify the colfunc to replace 0 with Rescale[200, valrange] and 1 with Rescale[250, valrange]? $\endgroup$ – kglr Jan 3 '18 at 19:38
  • $\begingroup$ No, I mean to plot all the points but assign a custom color (let's say magenta) to those for which the third element is between 200 and 250. All the rest of them should be according to your answer. $\endgroup$ – Vaggelis_Z Jan 3 '18 at 19:41
4
$\begingroup$ 
Clear["Global`*"];

n = 10^4;
Nmax = 10000;
SeedRandom[0];
data = Table[
   {RandomReal[{-1, 1}], RandomReal[{-1, 1}], RandomInteger[{0, 500}]},
   {i, 1, n}];

dataGroups = {
   Select[data, #[[3]] < 100 &],
   Select[data, 100 <= #[[3]] <= 400 &],
   Select[data, #[[3]] > 400 &]};

jet[u_?NumericQ] := 
  Blend[{{0, RGBColor[0, 0, 9/16]}, {1/9, Blue}, {23/63, 
      Cyan}, {13/21, Yellow}, {47/63, Orange}, {55/63, Red}, {1, 
      RGBColor[1/2, 0, 0]}}, u] /; 0 <= u <= 1;

Nmin = 100;
Nmax = 400;
valrange = {Nmin, Nmax};
dataGroups[[2, All, 3]] = 
  Rescale[dataGroups[[2, All, 3]] // N, valrange];

colfunc[x_] := jet[x[[3]]];
g0 = Graphics[{PointSize[0.01], 
   Point[#[[1 ;; 2]], VertexColors -> colfunc[#]] & /@ dataGroups[[2]],
   Gray, Point[#[[1 ;; 2]] & /@ dataGroups[[1]]],
   Darker[Red], Point[#[[1 ;; 2]] & /@ dataGroups[[3]]]}]

enter image description here

Improve this answer
$\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.