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
    Commented 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
    Commented 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
    Commented 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
    Commented 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
    Commented 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
    Commented 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
    Commented Dec 2, 2020 at 23:58

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