Advertisement
Matthen

Straight line merging to profile

Jan 18th, 2012
515
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.39 KB | None | 0 0
  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}]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement