Mathematica,459392字节
f=(d=ImageData@Import@#/.{a_,_,_}:>a;(For[a={};b={#&@@d~Position~1},b!={},c=#&@@b;b=Rest@b;d[[##&@@c]]=0;a~AppendTo~c;If[Extract[d,c+#]==1,b=b⋃{c+#}]&/@{e={1,0},-e,e={0,1},-e}];m=1.Mean@a;m=#-m&/@a;n=Count[Partition[Norm/@SortBy[m,ArcTan@@#&],300,1,1],l_/;l[[150]]==Max@l];(d[[##&@@#]]=Round[n^.68])&/@a)&/@Range@4;Image[d/.n_Integer:>{{0,0,0},,{0,1,0},{1,0,0},,,,{1,1,0},{0,0,1}}[[n+1]]])&
取消高尔夫:
f = (
d = ImageData@Import@# /. {a_, _, _} :> a;
(
For[a = {}; b = {# & @@ d~Position~1},
b != {},
c = # & @@ b;
b = Rest@b;
d[[## & @@ c]] = 0;
a~AppendTo~c;
If[Extract[d, c + #] == 1,
b = b ⋃ {c + #}] & /@ {e = {1, 0}, -e, e = {0, 1}, -e}
];
m = 1. Mean@a; m = # - m & /@ a;
n =
Count[Partition[Norm /@ SortBy[m, ArcTan @@ # &], 300, 1, 1],
l_ /; l[[150]] == Max@l];
(d[[## & @@ #]] = Round[n^.68]) & /@ a
) & /@ Range@4;
Image[d /.
n_Integer :> {{0, 0, 0}, , {0, 1, 0}, {1, 0, 0}, , , , {1, 1,
0}, {0, 0, 1}}[[n + 1]]]
) &
通过将m=1.Mean@a;m=#-m&/@a;
转换为m=#-Mean@a&/@a;
,我可以再节省6个字节,但这会极大地浪费执行时间,这对于测试很烦人。(请注意,这是二的优化:拉出的计算Mean@a
出循环的和。使用精确符号类型,而不是浮点数有趣的是,使用确切的类型是很多不是在每个迭代计算的平均值更显著。)
这是方法三:
仅作记录,如果我使用Ell的想法,并仅按任何像素与中心之间的最大距离对区域进行排序,则可以以342字节为单位:
f=(d=ImageData@Import@#/.{a_,_,_}:>a;MapIndexed[(d[[##&@@#]]=#&@@#2)&,SortBy[(For[a={};b={#&@@d~Position~1},b!={},c=#&@@b;b=Rest@b;d[[##&@@c]]=0;a~AppendTo~c;If[Extract[d,c+#]==1,b=b⋃{c+#}]&/@{e={1,0},-e,e={0,1},-e}];a)&/@Range@4,(m=Mean@#;Max[1.Norm[#-m]&/@#])&],{2}];Image[d/.n_Integer:>{{0,0,0},{0,0,1},{1,1,0},{1,0,0},{0,1,0}}[[n+1]]])&
但我无意与之竞争,只要其他所有人都使用自己的原始算法,而不是压制其他算法。