Group Abstract

Message Boards

WOLFRAM COMMUNITY

10.6K Views

6 Replies

4 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Computer Science Education Game Development Image Processing Mathematics Recreation Software Development Computational Linguistics

Could you tell me what am I doing wrong?

Luis Ledesma

Posted 11 years ago

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 = 2ele - 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 = cRandomVariate[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. Attachments:

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.

I want one like this

POSTED BY: Luis Ledesma

6 Replies

Sort By:

Luis Ledesma

Posted 11 years ago

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

POSTED BY: Luis Ledesma

Udo Krause

Udo Krause, NOrganization

Posted 11 years ago

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 = 2ele - 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 = cRandomVariate[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.

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.

enter image description here

POSTED BY: Udo Krause

Udo Krause

Udo Krause, NOrganization

Posted 11 years ago

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 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] It's still a bit artificial, you could also add an inclined plane to give it a tendency.

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

enter image description here

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]

enter image description here

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

POSTED BY: Udo Krause

Udo Krause

Udo Krause, NOrganization

Posted 11 years ago

Let's modestly say it did improve. But if one looks from above onto it one sees the rectangular subsquare structure, which is still artificial.

POSTED BY: Udo Krause

Luis Ledesma

Posted 11 years ago

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 :)

POSTED BY: Luis Ledesma

Udo Krause

Udo Krause, NOrganization

Posted 11 years ago

POSTED BY: Udo Krause

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback