Wolfram mathematica 如何在mathematica中模拟以下场景

假设我有

n=6个不同的单体，每个单体都有两个不同的活性端。在每一轮反应中，一个无规端与另一个无规端结合，要么将单体拉长成二聚体，要么自缔合成环。当系统中没有自由端时，该反应过程停止。我想用Mma来模拟反应过程

我想用字符串列表来表示单体，{'1-2'，'3-4'，'5-6'，'7-8'，'9-10'，'11-12'}，然后通过更新列表的内容来进行一轮的研究，例如，{'1-2-1'，'3-4'，'5-6'，'7-8'，'9-10'，'11-12'}或{'1-2-3-4'，'5-6'，'7-8'，'9-10'，'11-12'}。但是由于我在Mma的编程限制，我不能走得很远。有人能帮忙吗？非常感谢。
将分子表示为列表而不是字符串似乎更为自然。从{1,2}，{3,4}，{5,6}开始，依此类推。然后开链就是更长的列表{1,2,3,4}或其他什么，并且对于循环有一些特殊的约定，比如以符号“loop”开头。{{loop，1,2}，{3,4,5,6}，{7,8}等等

您的模拟实际需要多详细？例如，你真的关心哪个单体在哪个单体旁边结束，还是只关心链长度的统计？在后一种情况下，您可以大大简化模拟的状态：例如，它可以由循环长度列表（开始为空）和开放链长度列表（开始为一堆1）组成。然后一个模拟步骤是：随机选取一条开放链；以适当的概率，要么将其转化为一个循环，要么将其与另一个开放链相结合

Mathematica您可能想要查找的内容：RandomInteger、RandomChoice；前置、追加、插入、删除、替换零件、联接；While（虽然实际上是某种“功能性迭代”，例如nestwile可能会产生更漂亮的代码）。
以下是设置：

Clear[freeVertices];
freeVertices[edgeList_List] := Select[Tally[Flatten[edgeList]], #[[2]] < 2 &][[All, 1]];

ClearAll[setNew, componentsBFLS];
setNew[x_, x_] := Null;
setNew[lhs_, rhs_] := lhs := Function[Null, (#1 := #0[##]); #2, HoldFirst][lhs, rhs];

componentsBFLS[lst_List] := 
 Module[{f}, setNew @@@ Map[f, lst, {2}]; GatherBy[Tally[Flatten@lst][[All, 1]], f]];

以下是步骤：

In[51]:= steps = 
NestWhileList[Append[#, RandomSample[freeVertices[#], 2]] &, 
  start, freeVertices[#] =!= {} &]

Out[51]= {{{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}}, {{1, 
2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {5, 1}}, {{1, 
2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {5, 1}, {3, 
4}}, {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {5, 
1}, {3, 4}, {7, 11}}, {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 
10}, {11, 12}, {5, 1}, {3, 4}, {7, 11}, {8, 2}}, {{1, 2}, {3, 
4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}, {5, 1}, {3, 4}, {7, 11}, {8,
2}, {6, 10}}, {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 
12}, {5, 1}, {3, 4}, {7, 11}, {8, 2}, {6, 10}, {9, 12}}}

以下是您可以研究的连接组件（循环等）：

In[52]:= componentsBFLS /@ steps

Out[52]= {{{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}}, {{1, 2,
5, 6}, {3, 4}, {7, 8}, {9, 10}, {11, 12}}, {{1, 2, 5, 6}, {3, 
4}, {7, 8}, {9, 10}, {11, 12}}, {{1, 2, 5, 6}, {3, 4}, {7, 8, 11, 
12}, {9, 10}}, {{1, 2, 5, 6, 7, 8, 11, 12}, {3, 4}, {9, 10}}, {{1, 
2, 5, 6, 7, 8, 9, 10, 11, 12}, {3, 4}}, {{1, 2, 5, 6, 7, 8, 9, 10, 
11, 12}, {3, 4}}}

我们将所有对视为一个大图中的边，如果此时两个顶点最多有一条连接到另一条边，则随机添加一条边。在某个时候，这个过程停止了。然后，我们将componentsBFLS函数映射到生成的图（表示模拟的步骤）上，以获得图的连接组件（步骤）。当然，您也可以使用其他指标，编写更多函数来分析循环等的步骤。希望这能帮助您开始。
这里有一个简单的方法。根据问题中给出的例子，我假设单体具有优先结合，因此只有
{1,2}+{3,4}->{1,2,3,4}或{1,2,1}+{3,4,3}
是可能的，但是
{1,2}+{3,4}->{1,2,4,3}
是不可能的。一旦您对以下代码感到满意，就应该将其打包为一个好的函数/模块。如果你在寻找统计数据，那么它也可能被编译以增加一些速度

初始化：

In[1]:= monomers=Partition[Range[12],2]
        loops={}
Out[1]= {{1,2},{3,4},{5,6},{7,8},{9,10},{11,12}}
Out[2]= {}

循环：

In[3]:= While[monomers!={},
  choice=RandomInteger[{1,Length[monomers]},2];
  If[Equal@@choice, 
     AppendTo[loops, monomers[[choice[[1]]]]];
       monomers=Delete[monomers,choice[[1]]],
     monomers=Prepend[Delete[monomers,Transpose[{choice}]],
                      Join@@Extract[monomers,Transpose[{choice}]]]];
     Print[monomers,"\t",loops]
   ]
During evaluation of In[3]:= {{7,8,1,2},{3,4},{5,6},{9,10},{11,12}} {}
During evaluation of In[3]:= {{5,6,7,8,1,2},{3,4},{9,10},{11,12}}   {}
During evaluation of In[3]:= {{5,6,7,8,1,2},{3,4},{9,10}}   {{11,12}}
During evaluation of In[3]:= {{3,4,5,6,7,8,1,2},{9,10}} {{11,12}}
During evaluation of In[3]:= {{9,10}}   {{11,12},{3,4,5,6,7,8,1,2}}
During evaluation of In[3]:= {} {{11,12},{3,4,5,6,7,8,1,2},{9,10}}


编辑：
如果单体可以在两端结合，您只需添加一个选项来翻转所连接的单体，例如

Do[
  choice=RandomInteger[{1,Length[monomers]},2];
  reverse=RandomChoice[{Reverse,Identity}];
  If[Equal@@choice,
    AppendTo[loops,monomers[[choice[[1]]]]];
      monomers=Delete[monomers,choice[[1]]],
    monomers=Prepend[Delete[monomers,Transpose[{choice}]],
             Join[monomers[[choice[[1]]]],reverse@monomers[[choice[[2]]]]]]];
  Print[monomers,"\t",loops],{Length[monomers]}]

{{7,8,10,9},{1,2},{3,4},{5,6},{11,12}}  {}
{{3,4,5,6},{7,8,10,9},{1,2},{11,12}}    {}
{{3,4,5,6},{7,8,10,9},{11,12}}  {{1,2}}
{{7,8,10,9},{11,12}}    {{1,2},{3,4,5,6}}
{{7,8,10,9,11,12}}  {{1,2},{3,4,5,6}}
{}  {{1,2},{3,4,5,6},{7,8,10,9,11,12}}

我看到我的实现与Simon的实现非常相似。提醒自己：在发布解决方案之前不要睡觉

simulatePolimerization[originalStuff_] :=
 Module[{openStuff = originalStuff, closedStuff = {}, picks},
  While[Length[openStuff] > 0,
   picks = RandomInteger[{1, Length[openStuff]}, 2];
   openStuff = If[RandomInteger[1] == 1, Reverse[#], #] & /@ openStuff;
   If[Equal @@ picks,
    (* closing *)
    AppendTo[closedStuff,Append[openStuff[[picks[[1]]]], openStuff[[picks[[1]], 1]]]];
    openStuff = Delete[openStuff, picks[[1]]],
    (* merging *)
    AppendTo[openStuff,Join[openStuff[[picks[[1]]]], openStuff[[picks[[2]]]]]];
    openStuff = Delete[openStuff, List /@ picks]
  ]
 ];
 Return[closedStuff]
]

一些结果：

我不在乎哪一个单体在哪一个单体旁边结束；我关心的是循环长度的统计，当然还有循环的数量。如果你能发布一个工作实例，我将不胜感激。@QiangLi:一点礼貌是不会误入歧途的。加雷斯提出了正确的观点，并给出了很好的暗示。听起来他在这类模拟方面确实有经验。他只是想澄清你到底需要什么。@QiangLi:另外，在这样一个简单的系统中，你可能会找到你所问统计问题的解析解。@Simon，@Gareth，如果我之前的评论听起来不礼貌，我真的很抱歉。我真的没有这个打算。我非常感谢你的帮助虽然上述操作可以通过
nestwile
或
nestwilelist
在功能上执行（或者，因为您知道需要多少步骤，所以可以使用一个简单的
Nest
）。由于您希望收集有关动态的统计信息，您可能希望
将上述内容编译成函数，因此我使用的命令式样式应该可以。非常感谢。你的假设不是我的意思，尽管我可能没有明确说明这一点。{1,2}+{3,4}->{1,2,4,3}和{1,2}+{3,4}->{1,2,3,4}都是允许的，并被视为不同的。让我试着找出对代码的修改…这是非常新颖和简洁的方法！顺便说一句，“BFLS”是什么的缩写，呼吸优先列表搜索…？@Qiang Li No，这是参与编写此函数的人的名字的第一个字母：）。我在这里也提到了此函数：+1，用于“发布解决方案前决不睡觉”中的逻辑微妙之处
simulatePolimerization[originalStuff_] :=
 Module[{openStuff = originalStuff, closedStuff = {}, picks},
  While[Length[openStuff] > 0,
   picks = RandomInteger[{1, Length[openStuff]}, 2];
   openStuff = If[RandomInteger[1] == 1, Reverse[#], #] & /@ openStuff;
   If[Equal @@ picks,
    (* closing *)
    AppendTo[closedStuff,Append[openStuff[[picks[[1]]]], openStuff[[picks[[1]], 1]]]];
    openStuff = Delete[openStuff, picks[[1]]],
    (* merging *)
    AppendTo[openStuff,Join[openStuff[[picks[[1]]]], openStuff[[picks[[2]]]]]];
    openStuff = Delete[openStuff, List /@ picks]
  ]
 ];
 Return[closedStuff]
]