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.

Suppose we have a long list of random points (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) : enter image description here

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

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 :

enter image description here

share|improve this question
1  
Can you at least include a picture illustrating what you want to see from answers? –  J. M. Mar 23 '13 at 13:02
    
I've edited the question. Notice that the second picture is very crude (it was done in less than 1min, by hand, and I'm not good with my pictures editor). –  Cham Mar 23 '13 at 13:33
add comment

2 Answers

up vote 5 down vote accepted

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]

enter image description here

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:

enter image description here

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:

enter image description here

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}

share|improve this answer
    
That is nice. But the colors doesn't blend smoothly. See the yellow and black dots. Their delimitation is very sharp and clear. –  Cham Mar 23 '13 at 15:30
    
ah, you want to blend to "base" color too? I figured you just want to blend between the patches, see red - yellow. Let me think. –  Pinguin Dirk Mar 23 '13 at 15:31
    
Also, I'm yet unable to apply your color directive to my list of points. I need the color function to define a list of 4 numbers (RGB and opacity), as much multiplets that there are points in the distribution. I'll edit the question to give a full example with radial colors. –  Cham Mar 23 '13 at 15:37
    
That looks better. Actually, I could forget about the random distribution of the colors. I'll see if I can apply this to my project. –  Cham Mar 23 '13 at 15:58
    
to use opacity as well, one might just append that to the colors in inputs and baseCol. Will edit in a sec –  Pinguin Dirk Mar 23 '13 at 15:59
show 5 more comments

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}]

Three point clouds with different decay rates

share|improve this answer
add comment

Your Answer

 
discard

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.