36
$\begingroup$

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[
      Table[
         ((x - pts[[k, 1]])^2 + (y - pts[[k, 2]])^2)^(exponent),
         {k, 1, Length[pts]}
      ]
   ]);

Show[
   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_] = 
   Sum[
      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.

Improve this question
$\endgroup$

3 Answers 3

Reset to default
36
$\begingroup$

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.

Improve this answer
$\endgroup$
4
  • $\begingroup$ Damn! I was doing the same +1 :) $\endgroup$ Commented Mar 8, 2013 at 1:12
  • 1
    $\begingroup$ Wow, that's perfect! Thank you so much. $\endgroup$ Commented Mar 8, 2013 at 1:23
  • $\begingroup$ Maybe Total[ instead of Plus @@( ? $\endgroup$ Commented Mar 8, 2013 at 11:00
  • 1
    $\begingroup$ @Murta Yes, thanks. Plus @@ is an old habit that dies hard. $\endgroup$ Commented Mar 8, 2013 at 11:19
20
$\begingroup$

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

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$ Commented Mar 7, 2013 at 23:17
  • $\begingroup$ Beautiful and very bright. Very good idea! $\endgroup$ Commented Mar 13, 2013 at 21:04
10
$\begingroup$

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];
DensityPlot[
 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];
DensityPlot[
 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

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you. It is basically the same as an earlier one, but without the extra exponent variable. $\endgroup$ Commented Mar 13, 2013 at 20:39
  • $\begingroup$ It is glowing, really! $\endgroup$ Commented Aug 6, 2013 at 15:10

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.