Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have a set of points in the plane which I would like to have "glow". I would like for each point to glow individually and I would also like some increase in the intensity corresponding to an increase in density of the points.

I've come up with a couple ideas for how to do this using DensityPlot but neither are quite what I'm hoping for. I'll describe them below.

I need some points, say

pts = Table[{Re[E^(I t/2 - t/10)], Im[E^(I t/2 - t/10)]}, {t, 1, 50}];

The first idea is to consider an density function like

$$ \frac{1}{\epsilon + \min_{a \in \text{pts}}\operatorname{dist}((x,y),a)}. $$

My code for this is

eps = 1/16; exponent = 1/2;

distfunc1[x_, y_] = 
   1/(eps + Min[
         ((x - pts[[k, 1]])^2 + (y - pts[[k, 2]])^2)^(exponent),
         {k, 1, Length[pts]}

   DensityPlot[distfunc1[x, y], {x, -1, 1}, {y, -1, 1}, 
      PlotPoints -> 40],
   Graphics[{PointSize[0.007], Point[pts]}]

which produces

enter image description here

The non-differentiability of the density function leads to sharp divisions between the glows. To get around that I considered adding the distances instead of taking the minimum, like

$$ \sum_{a \in \text{pts}} \frac{1}{\epsilon + \operatorname{dist}((x,y),a)}. $$

My definition is

distfunc2[x_, y_] = 
      1/(((x - pts[[k, 1]])^2 + (y - pts[[k, 2]])^2)^(exponent) + eps),
      {k, 1, Length[pts]}

By varying the parameters eps and exponent I can get parts of what I want. For example with eps = 1/4 and exponent = 1/2 I get nice smooth glows around the outer points but the inner region becomes too "hot":

enter image description here

With eps = 1/2 and exponent = 1/1400 the middle is no longer too hot and has the brightest glow from the density but the outer points no longer have significant idividual glows:

enter image description here

I haven't yet found a way to have a nice strong glow in the center as well as distinct, nontrivial glows for each of the outer points. I appreciate any ideas you may have.

Also, I'm new to Mathematica and I don't really know how ColorFunction works. Is it easy to increase the range of lights/darks (i.e. increase contrast) in the color function used by DensityPlot to render its pictures? I would like the darkest color to be near-black in the above pictures if possible.

share|improve this question

3 Answers 3

up vote 27 down vote accepted

One important thing you probably want is PlotRange -> All. The white-hot spots are from plot range clipping. Another thing I add below is a little smoothing by considering (more or less) the harmonic mean of the distances to the two nearest points:

pts = Table[{Re[E^(I t/2 - t/10)], Im[E^(I t/2 - t/10)]}, {t, 1, 50}];

distfunc1[x_, y_, a_] := 
  Max[1 - a / Total[1/EuclideanDistance[{x, y}, #] & /@ Nearest[pts, {x, y}, 2]], 0]^2;

Show[DensityPlot[distfunc1[x, y, 10], {x, -1, 1}, {y, -1, 1}, 
  PlotPoints -> 40, PlotRange -> All], 
 Graphics[{PointSize[0.007], Point[pts]}]]

DensityPlot output

The intensity is given by 1 - a times the mean distance or 0, whichever is greater. The spread of the glow is controlled by a, the spread decreasing as a increases. Squaring Max smooths the transition of the intensity to 0. The image above is for a == 10.

share|improve this answer
Damn! I was doing the same +1 :) –  belisarius Mar 8 '13 at 1:12
Wow, that's perfect! Thank you so much. –  Antonio Vargas Mar 8 '13 at 1:23
Maybe Total[ instead of Plus @@( ? –  Murta Mar 8 '13 at 11:00
@Murta Yes, thanks. Plus @@ is an old habit that dies hard. –  Michael E2 Mar 8 '13 at 11:19

You can get a sort of interpolation between these two ideas by taking the total of the nearest two points. I reduce the intensity at the center by scaling as a function of distance from the center. Increasing MaxRecursion gets better resolution in the crowded middle. The use of ColorFunction to blend between black, blue and white is also shown:

distfunc[x_, y_] = 
  Norm[{x, y}] Total[
      Max[#] + RankedMax[#, 2]] &[(Norm[{x, y} - #])^-1 & /@ pts];
Show[DensityPlot[distfunc[x, y], {x, -1, 1}, {y, -1, 1}, 
  PlotPoints -> 40, MaxRecursion -> 4,
  ColorFunction -> (Blend[{{0, Black}, {0.5, Blue}, {1, 
        White}}, #] &)], Graphics[{PointSize[0.007], Point[pts]}]]

Glowy spiral

share|improve this answer
Thanks, that's pretty neat. Ideally the solution shouldn't rely on the geometry of these particular points, though. The goal is to apply this to some other arbitrary point sets. –  Antonio Vargas Mar 7 '13 at 23:17
Beautiful and very bright. Very good idea! –  Stefan Mar 13 '13 at 21:04

Here is an answer using a glow intensity falloff function of 1/(a*x+1). I set a to 5, but increase it to increase the sharpness of the glowing points. I do a sum from the 5 nearest points, but you can change that for a performance/accuracy tradeoff.

pts = Table[{Re[E^(I t/2 - t/10)], Im[E^(I t/2 - t/10)]}, {t, 1, 50}];
near = Nearest[pts];
 Module[{nearest = near[{x, y}, 5]}, 
  Sum[1/(5 EuclideanDistance[{x, y}, nearest[[a]]] + 1), {a, 
    Length@nearest}]], {x, -1, 1}, {y, -1, 1}, PlotRange -> All, 
 PlotPoints -> 40]

original points

It looks good with random points too.

pts = RandomReal[{-1, 1}, {100, 2}];
near = Nearest[pts];
 Module[{nearest = near[{x, y}, 5]}, 
  Sum[1/(5 EuclideanDistance[{x, y}, nearest[[a]]] + 1), {a, 
    Length@nearest}]], {x, -1, 1}, {y, -1, 1}, PlotRange -> All, 
 PlotPoints -> 40]

random points

share|improve this answer
+1, that second plot is beautiful. –  Antonio Vargas Mar 13 '13 at 20:30
Thank you. It is basically the same as an earlier one, but without the extra exponent variable. –  Michael Hale Mar 13 '13 at 20:39
It is glowing, really! –  asim Aug 6 '13 at 15:10

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

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