Colors associated to parts of a 3D distribution of points

Question

Suppose we have a long list of random points (in Cartesian coordinates) in 3D space.

coords := ...;

Until now, I was associating colors in a radial way, from the center to the edge of the distribution :

SpriteColor = Blend[{InternalColor, MiddleColor, MiddleColor2, ExternalColor}, #]&;

I'm now wondering how could we associate the colors by random "small patches" over the distribution of points, with smooth blending between the patches. What I mean by "patches" is this: some red here, blending to blue there, red again in another random part, blending to green over there, etc.

The random distribution of colors should need the number of "patches" as input, and a set of colors (as in my example above, for the radial distribution).

Any suggestion about how to do this?

For a crude example, here's a version with the radial colors (easy to do with the above color directive) :

And here's a very crude sketch (handmade) of what I would like to do, instead of a radial coloring. The patches should be randomly placed:

Notice that I'm working with Mathematica 7.

EDIT :

Here's a full working example for a radial color distribution on a cube of points. I would like to distribute the colors on, say, 7 spots randomly distributed on the whole distribution of points, instead of an unique radial blend.

InternalColor := RGBColor[0.95, 0.0, 0.0, 0.99]; (* color at the center of the distribution *)
MiddleColor := RGBColor[0.0, 0.95, 0.0, 0.9]; (* color of transition to the exterior part *)
ExternalColor := RGBColor[0.0, 0.0, 0.95, 0.9]; (* color of the exterior part *)

testCoords = RandomReal[{-1, 1},{10000, 3}];

radialColors = Blend[{InternalColor, MiddleColor, ExternalColor2}, #] &;

Graphics3D[{AbsolutePointSize[4], Point[testCoords, VertexColors ->(radialColors[Norm[#]] & /@ testCoords)]}, Boxed -> False, BoxRatios -> {1, 1, 1}, ImageSize -> 800, SphericalRegion -> True]

Output:

Answer 1

Sorry for all the edits! I hope this is now closer to what you expected.

BASIC CASE

First, we generate some coords in the unit cube:

coords = RandomReal[{-1, 1}, {10000, 3}];

Next, I create an input vector (deterministic):

inputs = {{Yellow, {1, 0, 0}, 1}, {Green, {1, 1, 1}, 
1}, {Blue, {-1, 0, 0}, 1}, {Red, {0, 0, 0}, 0.75}};

of the following form: {"Color","Center","Radius"}. Note that I chose this as a non-random vector, to get a slightly better picture of what happens. Also note that the colored patches will be spheres. For now I couldn't find any idea on how to make that randomly shaped.

You can then randomize the inputs vector to get random colors/centers/radii.

Based on the comments, I now fixed a baseCol and an "aggressiveness"-var that specifies how "aggressively" that base color eats into the patches. Play around and see.

For the next image, I chose:

aggr = 0.5;

and

baseCol = LightGray;

and the adjusted code:

Graphics3D[{Blend[Prepend[inputs[[All, 1]], baseCol], 
 With[{fun = 
    Function[x, 
      Max[0, 1 - 1/#[[3]] Norm[x - #[[2]]]] & /@ inputs][#]}, 
  Flatten@{Max[0, aggr - Total@fun], fun}]], Point@#} & /@ coords]

OPACITY:

say you want opacity as well, one could e.g. do something of the following:

baseCol = Append[LightGray, 0.25];

(rather opaque)

and

 inputs = {{Append[Yellow, 0.9], {1, 0, 0}, 
 1}, {Append[Green, 0.9], {1, 1, 1}, 
 1}, {Append[Blue, 0.7], {-1, 0, 0}, 
 1}, {Append[Red, 0.9], {0, 0, 0}, 0.75}};    

where I assumed that you already have your colors in that format, so excuse the syntax.

Then we get:

Your Layout

Based on your edit: If you want the coloring function "standalone", you could do:

myCol = {Blend[Prepend[inputs[[All, 1]], baseCol], 
 With[{fun = 
    Function[x, 
      Max[0, 1 - 1/#[[3]] Norm[x - #[[2]]]] & /@ inputs][#]}, 
  Flatten@{Max[0, aggr - Total@fun], fun}]]} &;

and then (in your layout):

Graphics3D[{AbsolutePointSize[4], 
 Point[coords, VertexColors -> (myCol /@ coords)]}, Boxed -> False, 
 BoxRatios -> {1, 1, 1}, ImageSize -> 500, SphericalRegion -> True]

to get:

NOTE: your SpriteColor function takes a real as input (as you only need the Norm to do the coloring), where myCol takes {x,y,z}

Answer 2

If one processes the list of points as a block, some speed-up can be realized from built-in optimization of some functions. This problem also amenable to compilation.

Some initial data:

testCoords = RandomReal[{-1, 1}, {10000, 3}];
colorCtrs = RandomReal[{-1, 1}, {7, 3}];
baseColors = Table[ColorConvert[Hue[i/7., 1, 1, 1.], "RGBColor"], {i, 7}];

A convenient function for plotting the colored point cloud:

spritePlot[spriteColorFn_, points_] := Graphics3D[{
   PointSize[0.0067], 
   Point[points, VertexColors -> spriteColorFn[points]]}, 
  Boxed -> False, SphericalRegion -> True, ImageSize -> 180]

Given a list of colors (as rgb and corresponding centers (points) for the colors, spriteCF computes the color or colors for the point or points (resp.) based on how close each point is to each center and on the decay rate. The colors of each center are averaged together with translucent gray, RGBColor[0.022, 0.022, 0.022, 0.022], each color being weight by Exp[-rate * dist^2], where dist is the distance to the color center, and gray receiving a constant weight of 0.08. The parameters 0.022 and 0.08 were chosen by trial.

The OP indicated a need for a function to handle a single point, so two interfaces are given to handle a single point and a list of points. As implied above, it is efficient on lists of points.

spriteCF[colors_, centers_, point_?VectorQ, rate_: 1.] := 
  First@cf[colors, centers, {point}, rate];
spriteCF[colors_, centers_, points_?MatrixQ, rate_: 1.] := 
  RGBColor @@@ compSCF[colors, centers, points, rate];
compSCF = 
  Compile[{{colors, _Real, 2}, {centers, _Real, 2}, {points, _Real, 
     2}, {rate, _Real}},
   Module[{weights},
    weights = 
     Exp@Map[-rate #.# &, (* wt = Exp[-rate * dist^2] *)
       Transpose[Table[points, {Length[centers]}]] - 
        Table[centers, {Length[points]}], {2}];
    ((0.022 + MapThread[ (* The 0.022 averages in some gray and lower opacity *)
               Dot,      (* and 0.08 determines the threshhold when gray is dominant *)
               {weights, Table[colors, {Length[points]}]}]) /
      (0.08 + Total[Transpose@weights]))
    ], RuntimeOptions -> "Speed"];

The higher the decay rate, the smaller the colored ball around each center. Below are plots for rate = 2, 6, 10:

Row@Table[spritePlot[spriteCF[baseColors, colorCtrs, #, r] &, testCoords], {r, 2, 10, 4}]