元胞自动机
6348人加入此小组
发新帖

【新图形】【B3/S23】【多图杀猫】新搜到的振荡子

读图模式

决定开一个新楼来放用Mathematica搜到的振荡子。

代码写得很烂,但搜12x12的周期2的振荡子应该是够了:

a = Merge[
   k[#[[;; 2]], 
       CellularAutomaton["GameOfLife", #][[2, 2]]] -> #[[3]] & /@ 
    Tuples[Tuples[{0, 1}, 3], 3], Identity];
g[x_, y_, z_] := 
  FindPath[Flatten@
     MapIndexed[
      Outer[v[#2 - 1, Most[#1]] -> v[#2, Rest[#1]] &, ##, 1] &, 
      Lookup[a, 
       MapThread[
        k, {First[
          Partition[{x, y}, {2, 3}, {2, 1}, {{1, -2}, {-1, 2}}, 0]], 
         z}], {}]], v[0, {0, 0}], v[Length[z], {0, 0}], Length[z] + 2,
     All][[;; , 2 ;;, 2, 1]];
With[{w = 12, h = 12, p = 2},
 o = Table[0, w + 2];
 i = g[o, o, o];
 f[l : {___, x_, y_}] := 
  If[Length@l == h + 2, 
   If[SameQ[##, o] & @@ y && SubsetQ[i, x], l, Missing["NotFound"]], 
   Catch[Do[
     If[MissingQ[#], , Throw[#]] &[f[Append[l, z]]], {z, 
      RandomSample[Tuples[MapThread[g, {x, y, RotateLeft[y]}]]]}]; 
    Missing["NotFound"]]];
 Transpose[
  NestWhile[f[{Table[o, p], RandomChoice[i, p]}] &, 
   Missing["NotFound"], MissingQ]]]

当然,如果有人要改进我的代码,或者用别的语言重写,我是非常欢迎的。

只有的搜索结果就不发了。

收藏 |
发表评论 0

评论 (45) 只看楼主

全部评论

小组最新帖子

关于我们 加入果壳 媒体报道 帮助中心 果壳活动 免责声明 联系我们 移动版 移动应用

©2017果壳网    京ICP证100430号    京网文[2015] 0609-239号    新出发京零字东150005号     京公网安备11010502007133号

违法和不良信息举报邮箱:jubao@guokr.com    举报电话:13691127034