Straight line merging to profile

By: Matthen on Jan 18th, 2012  |  syntax: None  |  size: 1.39 KB  |  hits: 118  |  expires: Never
download  |  raw  |  embed  |  report abuse
Copied
  1. pts={{0.146, -0.422}, {0.13, -0.406}, {0.118, -0.378}, {0.098, -0.35}, \
  2. {0.086, -0.318}, {0.058, -0.31}, {0.01, -0.306}, {-0.03, -0.294}, \
  3. {-0.058, -0.278}, {-0.078, -0.258}, {-0.07, -0.234}, {-0.074, \
  4. -0.222}, {-0.082, -0.21}, {-0.086, -0.194}, {-0.07, -0.178}, {-0.086, \
  5. -0.17}, {-0.094, -0.142}, {-0.094, -0.118}, {-0.098, -0.106}, \
  6. {-0.118, -0.09}, {-0.134, -0.074}, {-0.118, -0.042}, {-0.106, \
  7. -0.014}, {-0.09, 0.002}, {-0.09, 0.014}, {-0.094, 0.038}, {-0.106,
  8.   0.05}, {-0.102, 0.074}, {-0.098, 0.094}, {-0.094, 0.122}, {-0.098,
  9.   0.146}, {-0.094, 0.166}, {-0.098, 0.19}, {-0.086, 0.218}, {-0.07,
  10.   0.238}, {-0.05, 0.254}, {-0.026, 0.27}, {0.002, 0.278}, {0.034,
  11.   0.278}, {0.07, 0.286}, {0.098, 0.278}};
  12. Clear[line];
  13. line[0] =
  14.   Table[{0, i}, {i, -0.422, 0.286, (0.286 + 0.422)/41 + 0.0001}];
  15. line[n_] :=
  16.   line[n] =
  17.    SortBy[Map[# + {0.01, 0} &, line[n - 1]] +
  18.      RandomReal[NormalDistribution[0, 0.002], Dimensions[line[0]]],
  19.     Last];
  20. Clear[prof];
  21. prof[0] = Map[{1.5, 0} + # &, pts];
  22. prof[n_] :=
  23.   prof[n] =
  24.    SortBy[Map[# - {0.01, 0} &, prof[n - 1]] +
  25.      RandomReal[NormalDistribution[0, 0.002], Dimensions[prof[0]]],
  26.     Last];
  27. merge[n_] := (1 - n/140) line[n] + n/140 prof[140 - n];
  28. frame[n_] := Graphics[{
  29.     Table[BezierCurve@MovingAverage[merge[i], 2], {i, 0, Floor[n]}]
  30.     }, PlotRange -> {{0, 1.7}, {-0.43, 0.3}}];
  31. Manipulate[frame[n],{n,1,140,1}]