找琼脂

作者: AlephAlpha | 来源:发表于2018-07-02 13:29 被阅读1次

    之前试着重写了搜索静物的代码:把找静物看做是一个布尔可满足性问题,然后用 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:

    这个代码还是太慢,没法用来找周期3的琼脂。

    相关文章

      网友评论

        本文标题:找琼脂

        本文链接:https://www.haomeiwen.com/subject/netluftx.html