4
$\begingroup$

I'm trying to produce some graphics like the one shown below, with a few adjustable parameters to change the number and size of cells. The cells positions, sizes and colors should all be random (size between some min and max values):

enter image description here

The whole graphics should be shown inside a simple square, just for convenience for exportation.

My problem is that I really don't know how to start this, since there are many random vertices and straight lines dividing the domains. This is a kind of Mathematica programming problem that I'm unable to do by myself alone. :-(

I could start with a set of random points in a plane, using this code:

RandomPoints = 
  Table[{RandomReal[{-10, 10}], RandomReal[{-10, 10}]}, {n, 1, 50}];

ListPlot[RandomPoints,
 Axes -> False,
 Frame -> True,
 FrameTicks -> None,
 AspectRatio -> 1
 ]

But then, how to draw lines between these points, without any crossing, so we could get nice looking cells?

So I need suggestions. I don't need anything fancy, just the simplest tricks that I could study and understand. I'm working on Mathematica 7, and I can't change the computer for a newer version of Mathematica yet.

$\endgroup$
5

3 Answers 3

7
$\begingroup$

ListDensityPlot

Normal[ListDensityPlot[RandomReal[10, {100, 3}], 
  InterpolationOrder -> 0, ImageSize -> Large, Frame -> False]] /. 
 Polygon[x_, ___] :> {Hue@RandomReal[], EdgeForm[Gray],Polygon[x]}

enter image description here

SeedRandom[1]
ListDensityPlot[RandomReal[10, {100, 3}], InterpolationOrder -> 0, 
 ImageSize -> Large, Frame -> False, ColorFunction -> "Pastel"]

enter image description here

ListContourPlot

Normal[ListContourPlot[RandomReal[10, {100, 3}], 
   InterpolationOrder -> 0, ImageSize -> Large, Frame -> False]] /. 
 Polygon[x_, ___] :> {Hue@RandomReal[], EdgeForm[Gray], Polygon[x]}

enter image description here

An example with less randomness: randomly perturbed hexagons:

SeedRandom[1]
lst = Join @@ Array[{RandomReal[.3] + 3/2 #, 
      RandomReal[] + Sqrt[3] #2 + Mod[#, 2] Sqrt[3]/2, 
      RandomInteger[100]} &, {9, 9}];


Normal[ListContourPlot[lst, InterpolationOrder -> 0, 
   ImageSize -> Large, Frame -> False]] /. 
 Polygon[x_, ___] :> {Hue@RandomReal[], EdgeForm[Gray], Polygon[x]}

enter image description here

DensityPlot + Nearest

SeedRandom[1]
nearestFunction = First @* Nearest[Table[RandomInteger[10, 2] -> u, {u, 120}]];

ContourPlot[nearestFunction[{x, y}], {x, 0, 10}, {y, 0, 10}, 
 PlotPoints -> 90, Contours -> 50, ColorFunction -> "SolarColors", 
 Frame -> False, ImageSize -> Large]

enter image description here

$\endgroup$
7
  • $\begingroup$ @Cham, Hue @ RandomReal[] should work in v7. $\endgroup$
    – kglr
    Dec 3, 2020 at 0:17
  • $\begingroup$ Well, I need some help for the colors in my solution. I would like to get rid of that part before @@@pts, which I really don't understand. $\endgroup$
    – Cham
    Dec 3, 2020 at 0:20
  • $\begingroup$ These colors are very agressive. Could you change them for something more "pastel-like", like the image I've shown in my question? $\endgroup$
    – Cham
    Dec 3, 2020 at 0:39
  • $\begingroup$ Also, your last example shows cells that all have 6 sides (a few have 5). It should be more random than that. $\endgroup$
    – Cham
    Dec 3, 2020 at 0:42
  • 1
    $\begingroup$ does ListDensityPlot[RandomReal[10, {100, 3}], InterpolationOrder -> 0, ImageSize -> Large, Frame -> False, ColorFunction -> "Pastel"] work in v7? $\endgroup$
    – kglr
    Dec 3, 2020 at 0:45
5
$\begingroup$

Thanks @Cham @kglr, the ListContourPlot is a good idea.

I think we can also does not change the original points in the plane,so we append the three coordinate with different number. Here we just use {1,2,...,n}

And we use ContourShading to add the colors.

The final result is just the same as VoronoiMesh!

SeedRandom[123];
pts = RandomReal[{-1, 1}, {50, 2}];
pts3 = MapIndexed[Join, pts];
ListContourPlot[pts3, InterpolationOrder -> 0, 
 ContourShading -> Table[CMYKColor[RandomReal[{0, 1}, 3]], {i, 50}], 
 BoundaryStyle -> White, Axes -> False, Frame -> False]
Show[%, ListPlot[pts, PlotStyle -> White]]

Compare the 2D and 3D versions.

ListPlot3D[pts3, InterpolationOrder -> 0, ColorFunction -> "Rainbow", 
 Mesh -> None, Axes -> None, ViewPoint -> {0.54, -1.49, 2.98}, 
 ViewProjection -> "Orthographic"]

enter image description here

$\endgroup$
1
  • $\begingroup$ MapIndexed[Flatten[{##}] &, RandomReal[{-1, 1}, {50, 2}]] $\endgroup$
    – cvgmt
    Dec 4, 2020 at 0:49
4
$\begingroup$

Well, I just found a nice trick, but it's not fully satisfying yet, since the cell color isn't random. How can I modify this code to get random colors in all cells?

pts = RandomReal[{-1, 1}, {50, 2}];

f[{x_, y_}] := x^2 - y^2 (* I don't understand the color part ! *)

ListContourPlot[Function[{x, y}, {x, y, f[{x, y}]}] @@@pts,
  Mesh -> All,
  MeshStyle -> Thick,
  InterpolationOrder -> 0,
  Axes -> False,
  Frame -> True,
  FrameTicks -> None,
  AspectRatio -> 1
 ]

Preview:

enter image description here

$\endgroup$
1
  • $\begingroup$ I could replace the function x^2 - y^2 with something like RandomReal[{-1, 1}], which gives some random variations in colors, but it's always in shades of blue. I don't understand this part. $\endgroup$
    – Cham
    Dec 2, 2020 at 23:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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