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

找琼脂

读图模式

之前试着重写了搜索静物的代码:把找静物看做是一个布尔可满足性问题,然后用 Mathematica 自带的 SatisfiabilityInstances 函数。这样找静物还行,比原来还快一些。但找振荡子就出奇地慢,至今没找到过周期大于3或者大小大于10x10的振荡子。

不过,那个代码略作修改之后,倒是可以用来找琼脂(Agar,与振荡子或静物类似,但在空间上也是周期性的,覆盖整个平面)。找琼脂同样也很慢,但至少在周期2,也有不少个头不大的有趣的琼脂。

With[{w = 5, h = 5, p = 2, n = 1}, 
 Block[{r = RandomInteger[1, {w, h, p}]}, 
  Transpose[
     Mod[r + ArrayReshape[Boole@#, {w, h, p}], 2], {2, 3, 1}] & /@ 
   SatisfiabilityInstances[
    Array[BooleanConvert[(! 
              b[##] && (b[#, #2, #3 + 1] \[Equivalent] 
               BooleanCountingFunction[{{3}}, 
                Flatten@Array[b, {3, 3, 1}, {##} - {1, 1, 0}]~Delete~
                 5])) || (b[##] && (b[#, #2, #3 + 1] \[Equivalent] 
               BooleanCountingFunction[{{2, 3}}, 
                Flatten@Array[b, {3, 3, 1}, {##} - {1, 1, 0}]~Delete~
                 5])) //. {b[0, j_, t_] :> b[w, j, t], 
           b[w + 1, j_, t_] :> b[1, j, t], b[i_, 0, t_] :> b[i, h, t],
            b[i_, h + 1, t_] :> b[i, 1, t], 
           b[i_, j_, p + 1] :> b[i, j, 1]} /. {b[i_, j_, t_] /; 
            r[[i, j, t]] == 1 :> ! b[i, j, t]}, "BFF"] &, {w, h, p}, 
      1, And] && 
     Array[BooleanConvert[! Equal @@ Table[b[##, t], {t, p}], 
         "BFF"] /. {b[i_, j_, t_] /; r[[i, j, t]] == 1 :> ! 
           b[i, j, t]} &, {w, h}, 1, Or], Flatten@Array[b, {w, h, p}],
     n]]]

下面是找到的一些结果,都是周期2:

4x4:

5x5:

收藏 |
发表评论 1

评论 (2) 只看楼主

全部评论

小组最新帖子

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

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

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