Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- pts={{0.146, -0.422}, {0.13, -0.406}, {0.118, -0.378}, {0.098, -0.35}, \
- {0.086, -0.318}, {0.058, -0.31}, {0.01, -0.306}, {-0.03, -0.294}, \
- {-0.058, -0.278}, {-0.078, -0.258}, {-0.07, -0.234}, {-0.074, \
- -0.222}, {-0.082, -0.21}, {-0.086, -0.194}, {-0.07, -0.178}, {-0.086, \
- -0.17}, {-0.094, -0.142}, {-0.094, -0.118}, {-0.098, -0.106}, \
- {-0.118, -0.09}, {-0.134, -0.074}, {-0.118, -0.042}, {-0.106, \
- -0.014}, {-0.09, 0.002}, {-0.09, 0.014}, {-0.094, 0.038}, {-0.106,
- 0.05}, {-0.102, 0.074}, {-0.098, 0.094}, {-0.094, 0.122}, {-0.098,
- 0.146}, {-0.094, 0.166}, {-0.098, 0.19}, {-0.086, 0.218}, {-0.07,
- 0.238}, {-0.05, 0.254}, {-0.026, 0.27}, {0.002, 0.278}, {0.034,
- 0.278}, {0.07, 0.286}, {0.098, 0.278}};
- Clear[line];
- line[0] =
- Table[{0, i}, {i, -0.422, 0.286, (0.286 + 0.422)/41 + 0.0001}];
- line[n_] :=
- line[n] =
- SortBy[Map[# + {0.01, 0} &, line[n - 1]] +
- RandomReal[NormalDistribution[0, 0.002], Dimensions[line[0]]],
- Last];
- Clear[prof];
- prof[0] = Map[{1.5, 0} + # &, pts];
- prof[n_] :=
- prof[n] =
- SortBy[Map[# - {0.01, 0} &, prof[n - 1]] +
- RandomReal[NormalDistribution[0, 0.002], Dimensions[prof[0]]],
- Last];
- merge[n_] := (1 - n/140) line[n] + n/140 prof[140 - n];
- frame[n_] := Graphics[{
- Table[BezierCurve@MovingAverage[merge[i], 2], {i, 0, Floor[n]}]
- }, PlotRange -> {{0, 1.7}, {-0.43, 0.3}}];
- Manipulate[frame[n],{n,1,140,1}]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement