Could you tell me what am I doing wrong?

Questions
, , , , , ,
1

Again sharing my problems, sharing information with some friends one of them i shared this code in Matlab and try to do the same in Mathematica, i found myself with the unpleasant surprise that don’t know if the function ArrayResample do the same as the function interp2 Matlab,the code is short and my attempt to do the same in Mathematica is the following.

    terre = ConstantArray[0, {2, 2}];
      c = 0.1;
For[i = 1, i < 7, i++,
 ele = Length[terre];
 nLon = 2*ele - 1;
 (*paso B*)terre = ArrayResample[terre, nLon];
 subsquares = ConstantArray[1, Dimensions[terre]];
 subsquares[[1 ;; Length[subsquares] ;; 2, 
   1 ;; Length[subsquares] ;; 2]] = 0;
 vals = Position[subsquares, 1];
 randmap = c*RandomVariate[NormalDistribution[], Dimensions[terre]];
 rval = Extract[randmap, vals];
 camb = Thread[vals -> rval];
 terre = ReplacePart[terre, camb];
 c = c/2;
 ]

The attached file in Matlab for you tell me some idea of why the chart does not i get equal.

Here is the graphics obteined with mathematica

ListPlot3D[terre, Mesh -> None, Boxed -> False, Axes -> False, 
 ColorFunction -> ColorData["Rainbow"], DataRange -> {{0, 1}, {0, 1}},
  Background -> GrayLevel[.1]]

But you should see a graph like this, here is the graph.

likethis.PNG.jpg
likethis.PNG.jpg867×470 64.6 KB

2

Store the intermediate values of terre on an associative array pic and plot it at the end to see what happened:

Remove[pic, c, terre, subsquares]
terre = ConstantArray[0, {2, 2}];
c = 0.1;
For[i = 1, i < 7, i++, ele = Length[terre]; nLon = 2*ele - 1;(*paso B*)
 terre = ArrayResample[terre, nLon]; 
 subsquares = ConstantArray[1, Dimensions[terre]]; 
 subsquares[[1 ;; Length[subsquares] ;; 2, 
    1 ;; Length[subsquares] ;; 2]] = 0; 
 vals = Position[subsquares, 1]; 
 randmap = c*RandomVariate[NormalDistribution[], Dimensions[terre]]; 
 rval = Extract[randmap, vals]; camb = Thread[vals -> rval]; 
 terre = ReplacePart[terre, camb];
 pic[i] = terre;
 c = c/2
 ]

GraphicsGrid[
 Partition[
  ListPlot3D[pic[#], Mesh -> None, 
     ColorFunction -> ColorData["Rainbow"], 
     DataRange -> {{0, 1}, {0, 1}},(* Background\[Rule]GrayLevel[.1],*) 
     Mesh -> All, Boxed -> True, Axes -> True] & /@ Range[6], 3]]

comm584065.PNG.jpg
comm584065.PNG.jpg879×622 140 KB

you seem to refine and damp the perturbations again and again around 0 terrain level. If instead you respect the previous terre by adding the new one on it

Remove[pic, c, terre, subsquares]
terre = ConstantArray[0, {2, 2}];
c = 0.1;
For[i = 1, i < 7, i++, ele = Length[terre]; nLon = 2*ele - 1;(*paso B*)
 terre = ArrayResample[terre, nLon]; 
 subsquares = ConstantArray[1, Dimensions[terre]]; 
 subsquares[[1 ;; Length[subsquares] ;; 2, 
    1 ;; Length[subsquares] ;; 2]] = 0; 
 vals = Position[subsquares, 1]; 
 randmap = c*RandomVariate[NormalDistribution[], Dimensions[terre]]; 
 rval = Extract[randmap, vals]; camb = Thread[vals -> rval]; 
 terre += ReplacePart[terre, camb];
 pic[i] = terre;
 c = c/2
 ]

it looks far more natural:

comm584065_2.PNG.jpg
comm584065_2.PNG.jpg877×622 126 KB

3

Udo Krause, that great help you have given me, with what you have showed me and corrected I have remained convinced in the result, thank you very much, without your help it would not have been possible, I like very much the images that are obtained.

Greetings Luis Ledesma :slight_smile:

4

Let’s modestly say it did improve. But if one looks from above onto it

comm584065_3.PNG.jpg
comm584065_3.PNG.jpg970×784 157 KB

one sees the rectangular subsquare structure, which is still artificial.

5

To cure this, one could do

ledesmaSpec[{a_, f_, x0_, y0_}, x_, y_] := a Cos[f Sqrt[(x - x0)^2 + (y - y0)^2]] Exp[-Sqrt[(x - x0)^2 + (y - y0)^2]]

Clear[freqs]
With[{len = 17},
 freqs = Transpose[{RandomReal[{-2, 2}, len], RandomReal[5 \[Pi], len], RandomReal[1, len], RandomReal[1, len]}];
 ]

Plot3D[Plus @@ (ledesmaSpec[#, x, y] & /@ freqs), {x, 0, 1}, {y, 0, 1}, 
 ColorFunction -> ColorData["Rainbow"], Background -> GrayLevel[.1], Mesh -> None]

to see

comm584065_4.PNG.jpg
comm584065_4.PNG.jpg809×671 79.3 KB

note that freqs has all random real selectors executed only once. To let it appear not so smooth, trench it with a random real which is evaluated during graphics construction

Plot3D[Plus @@ (ledesmaSpec[#, x, y] & /@ freqs) + RandomReal[0.1], {x, 0, 1}, {y, 0, 1}, 
 ColorFunction -> ColorData["Rainbow"], Background -> GrayLevel[.1], Mesh -> None]

comm584065_5.PNG.jpg
comm584065_5.PNG.jpg794×658 92.6 KB

It’s still a bit artificial, you could also add an inclined plane to give it a tendency.

6

This gives reasonably grid-non-artificial landscapes

Remove[pic, c, terre, subsquares] 
With[{endIt = 10},
 terre = ConstantArray[0, {2, 2}]; c = 0.1; 
 For[i = 1, i < endIt, i++, ele = Length[terre]; 
  nLon = 2*ele - 1;(*paso B*)terre = ArrayResample[terre, nLon]; 
  subsquares = ConstantArray[1, Dimensions[terre]]; 
  subsquares[[
    1 ;; Length[subsquares] ;; 
     RandomChoice[Range[2, Ceiling[Length[subsquares]/2]]], 
    1 ;; Length[subsquares] ;; 
     RandomChoice[Range[2, Ceiling[Length[subsquares]/2]]]]] = 0; 
  vals = Position[subsquares, 1]; 
  randmap = c*RandomVariate[NormalDistribution[], Dimensions[terre]]; 
  rval = Extract[randmap, vals]; camb = Thread[vals -> rval]; 
  terre += ReplacePart[terre, camb]; pic[i] = terre; c = c/2
  ]
 ]

it is Luis’ code with one more modification on placing zeroes.

comm584065_6.PNG.jpg
comm584065_6.PNG.jpg903×741 191 KB

7

Hi UDO KRAUSE , thanks for to go further into the matter, the truth you’ve contributed a lot to improve the appearance of graphs that are obtained, run your code and my machine only able to support up to the iteration 8 for plotting, already that when trying to plot the iteration 9 took too long, but your code for the construction of terre remains amazing and short,thank you for sharing your improvements, I hope that someone else also enjoy this marvel.Sincerely Luis