Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- height = 1;
- width = 1;
- DeleteSmallLine[exp_, minLength_] := Module[{lines = exp, len, min, pos, p1, p2, rlz, sides, result},
- lines = lines /. Line[a_List] :> Line@Sort@a // Union;
- len = lines /. Line[{a_, b_}] :> Norm[b-a];
- min = Min@len; pos = Position[len, min];
- If[min > minLength,
- exp
- ,
- {p1, p2} = First@First@Extract[lines, pos];
- sides = N@{{0,0}, {0, height}, {width, 0}, {width, height}};
- rlz = Which[
- MemberQ[sides, p1], {p2 -> p1},
- MemberQ[sides, p2], {p1 -> p2},
- p1[[1]] == 0 \[Or] p1[[1]] == width \[Or] p1[[2]] == 0 \[Or] p1[[2]] == height , {p2 -> p1},
- p2[[1]] == 0 \[Or] p2[[1]] == width \[Or] p2[[2]] == 0 \[Or] p2[[2]] == height, {p1 -> p2},
- True, {p1 -> Mean[{p1, p2}], p2 -> Mean[{p1, p2}]}
- ];
- result = exp /. rlz /. Line[a_List] :> Line@Sort@a // Union;
- result = DeleteCases[result, Line[{a_, a_}]]
- ]
- ]
- DeleteSmallLines[exp_, minLength_] := FixedPoint[DeleteSmallLine[#, minLength] &, exp, SameTest -> (#1 == #2 &)]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement