7
$\begingroup$

I am trying to generate a random (white noise) signal, as mentioned in the section Frequency Synthesis of Landscapes (and clouds) on this website. The problem I have is that I do not know if WhiteNoiseProcess is the right function to make white noise in 2D.

I have tried it in the following way without success:

SeedRandom[1234];
test = RandomFunction[
    WhiteNoiseProcess[NormalDistribution[]], {0, 256}, 2]["ValueList"];

ListPlot[Transpose@test]

Mathematica graphics

Note that Dimension[test] is {2, 257}, which isn't what I want.

These are the kind of pictures that I want to make:

I want make this

I would like for you to please guide me to know how to do this in Mathematica. Thank you in advance for your help.

$\endgroup$
  • $\begingroup$ Paul Nylander implemented frequency-filtered random noise here. I made a slight modification of it here. $\endgroup$ – J. M. will be back soon Nov 5 '17 at 8:46
  • $\begingroup$ I think this answer is actually exactly the process you want: mathematica.stackexchange.com/a/80519/38205 $\endgroup$ – b3m2a1 Nov 5 '17 at 9:54
  • $\begingroup$ @J.M. I really like your modification, I'm still waiting for your technique for bigger islands, I will review your code in detail to learn more, thanks for the recommendation $\endgroup$ – bullitohappy Nov 5 '17 at 22:58
  • $\begingroup$ @b3m2a1 Maybe with the answer you gave on the pink noise,you will find that there is a relationship between perlin noise and pink noise or not. I am reviewing it to draw my conclusions, excellent recommendation $\endgroup$ – bullitohappy Nov 5 '17 at 23:05
9
$\begingroup$

Update:

Just for fun, here's the process I think you were trying to implement. Wikipedia suggested to me that it was called pink noise, so we'll use pink names.

pinkify =
  Compile[
   {{data, _Complex, 2}, {center, _Real, 1}, {p, _Real}},
   MapIndexed[
    #/(Norm[#2 - center]^p) &,
    data,
    {2}
    ]
   ];
pinkNoiseTransform[
   data : {{__}, ___}, 
   center : {_?NumericQ, _?NumericQ} | Automatic : Automatic,
   p : _?NumericQ : 1,
   fn : Except[_?NumericQ] : Abs
   ] :=
  Map[
   fn,
   InverseFourier@
    pinkify[Fourier[data],
     If[IntegerQ[#], # + .8, #] & /@ 
      Replace[center, Automatic :> Dimensions[data]/2],
     p
     ],
   {2}
   ];
pinkNoiseTransform[i : _Integer | {_Integer, _Integer}, r___] :=

 pinkNoiseTransform[whiteNoise2D[i], r]

I think the center point we assign minus the position in the matrix is f, so that's what I'm using 1/f.

Here's an example:

dims = {100, 100};
data = whiteNoise2D[dims];
centralFrequency = dims/2;
power = 1.8;
pinky = pinkNoiseTransform[data, centralFrequency, power, Norm];

Image[
 Rescale[pinky, MinMax[pinky], {1, 0}],
 ColorSpace -> "Grayscale",
 ImageSize -> {300, 300},
 Interleaving -> True
 ]

enter image description here

One cool thing is that we can use the Re and Im parts of our data as different channels:

rePink =
  pinkNoiseTransform[data, centralFrequency, power, Re];
imPink =
  pinkNoiseTransform[data, centralFrequency, power, Im];

Image[
 MapThread[
  List,
  {
   Rescale[pinky, {0, 1}, {1, 0}],
   Rescale[rePink, {0, 1}, {1, 0}],
   Rescale[imPink, {0, 1}, {1, 0}]
   },
  2],
 ColorSpace -> "RGB",
 ImageSize -> {300, 300},
 Interleaving -> True
 ]

asd2

Finally, here's some 3D terrain from a smaller version of this (note that anything except PerformanceGoal->"Speed" gives too jagged as surface):

terrain =
  Join @@
   MapIndexed[
    Append[#2, #] &,
    pinkNoiseTransform[350, centralFrequency, power],
    {2}
    ];

ListPlot3D[terrain,
 ColorFunction -> "GreenBrownTerrain",
 PerformanceGoal -> "Speed"
 ]

fdsfd


I think you've got the wrong idea about what it's generating. The 2 simply means do 2 traces.

Try this:

whiteNoise2D[n_Integer] :=
  whiteNoise2D[{n, n}];
whiteNoise2D[{n_, m_}] :=

  RandomFunction[WhiteNoiseProcess[], {0, n}, m]["ValueList"];
whiteNoiseImage[{n_, m_}, size_: Automatic] :=

 Image[whiteNoise2D[{n, m}],
  ImageSize -> Replace[size, Automatic :> {n, m}]
  ]

Image[Rescale[whiteNoise2D[{500, 500}]],
 ImageSize -> {250, 250}]

asd

$\endgroup$
  • $\begingroup$ I might do it as whiteNoise2D[n_Integer] := whiteNoise2D[{n, n}]; whiteNoise2D[{n_, m_}] := RandomFunction[WhiteNoiseProcess[], {0, n}, m]["ValueList"]; and then Image[Rescale[whiteNoise2D[{500, 500}]]]. $\endgroup$ – J. M. will be back soon Nov 5 '17 at 8:49
  • $\begingroup$ @J.M. I like that setup better. I'll change mine. $\endgroup$ – b3m2a1 Nov 5 '17 at 8:50
  • $\begingroup$ Your results seem to have spatially varying contrast along some diagonal bands. I'm pretty sure that shouldn't be the case. $\endgroup$ – Rahul Nov 6 '17 at 0:34
  • $\begingroup$ @Rahul Hm. That seems to be correlated to my choice of .00001 as a factor to push it away from division by 0 points. .8 still has fuzzy band parts, just not regular and not on the diagonal. Less than .8 seems to show regular bands. $\endgroup$ – b3m2a1 Nov 6 '17 at 0:41
  • $\begingroup$ @b3m2a1 Thanks for helping me implement the algorithm I showed, it's very funny to use pink names, but Wikipedia suggests it. I am trying to understand the code you provided, for this reason I hardly comment on your answer. You were right about how wrong I was using the 2 in the WhiteNoiseProcess command. $\endgroup$ – bullitohappy Nov 6 '17 at 15:09
7
$\begingroup$

We can use RandomVariate like this to generate white noise:

RandomVariate[UniformDistribution[], {256, 256}] // Image

Mathematica graphics

RandomVariate[NormalDistribution[], {256, 256}] // Image

Mathematica graphics

To just get the image, there is also RandomImage:

RandomImage[]

Mathematica graphics

RandomImage[NormalDistribution[]]

Mathematica graphics

The underlying data can be retrieved using ImageData.

The 3D visualization in the screenshot in the question is the same underlying data visualized with a ListPlot3D like function:

ListPlot3D[
 RandomVariate[UniformDistribution[], {256, 256}],
 ColorFunction -> GrayLevel
 ]

Mathematica graphics

ListPlot3D[
 RandomVariate[NormalDistribution[], {256, 256}],
 ColorFunction -> GrayLevel
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ C.E. Thank you for giving me other commands that serve to do what I want, I will try to do the following steps of the section mentioned above, to better understand the algorithm of the author and the solutions that the other members of this group have proposed $\endgroup$ – bullitohappy Nov 5 '17 at 23:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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