как смоделировать следующий сценарий в Mathematica

Question

Предположим, у меня есть 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. Может ли кто-нибудь помочь, пожалуйста? Большое спасибо.

Answer 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]
]

Некоторые результаты:

Answer 2

Вот установка:

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[13]:= start = Partition[Range[12], 2]

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

Вот шаги:

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}}}

В результате мы рассматриваем все пары как ребра в одном большом графе и добавляем ребро случайным образом, если обе вершины имеют не более одной связикакой-то другой край в данный момент.В какой-то момент процесс останавливается.Затем мы отображаем функцию componentBFLS на результирующие графы (представляющие этапы моделирования), чтобы получить связанные компоненты графиков (этапы).Конечно, вы можете использовать и другие метрики и написать больше функций, которые будут анализировать шаги для циклов и т. Д. Надеюсь, это поможет вам начать.

Answer 3

Вот простой подход.Следуя примерам, приведенным в этом вопросе, я предположил, что мономеры имеют предпочтительное связывание, так что возможно только {1,2} + {3,4} -> {1,2,3,4} OR {1,2,1} + {3,4,3}, но {1,2} + {3,4} -> {1,2,4,3} невозможно.Следующий код должен быть упакован как хорошая функция / модуль, как только вы будете довольны этим.Если вам нужна статистика, то, вероятно, ее также можно скомпилировать, чтобы добавить некоторую скорость.

Initialize:

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}}

Answer 4

Кажется, что было бы более естественно представлять ваши молекулы в виде списков, а не строк.Итак, начните с {{1,2}, {3,4}, {5,6}} и так далее.Тогда открытые цепочки - это просто более длинные списки {1,2,3,4} или что-то еще, и у них есть специальное соглашение для циклов, например, начиная с символа «цикл».{{loop, 1,2}, {3,4,5,6}, {7,8}} или что-то еще.

Насколько детальной должна быть ваша симуляция?Например, вас действительно волнует, какие мономеры окажутся рядом с какими, или вас интересует только статистика длин цепей?В последнем случае вы могли бы значительно упростить состояние вашей симуляции: он мог бы, например, состоять из списка длин цикла (который начинался бы пустым) и списка длин открытой цепочки (который начинался бы как набор из 1).Тогда один шаг моделирования: выбрать случайную открытую цепь;с соответствующими вероятностями, либо превратите это в цикл, либо объедините его с другой открытой цепью.

Mathematica вещи, которые вы, возможно, захотите посмотреть: RandomInteger, RandomChoice;Prepend, Append, Insert, Delete, ReplacePart, Join;Хотя (хотя на самом деле какая-то «функциональная итерация» с, например, NestWhile могла бы сделать для более красивого кода).