Related
Fellows,
I couldn't figure why I am having the warning message from the following code in Mathematica:
data = {{0, 1}, {1, 0.02307044673005989`}, {2,
0.00784879347316981`}, {3, 0.0061305265946403195`}, {4,
0.0008550610216054799`}, {5, 0.00010928133254420425`}, {6,
0.000011431049984759768`}, {7, 1.93788101788827`*^-6}, {8,
1.6278670621771263`*^-6}, {9, 2.6661469926370584`*^-7}, {10,
3.443821224260662`*^-8}, {11, 7.413060538191399`*^-9}, {12,
1.4031525687948224`*^-9}, {13, 5.973790450062338`*^-10}, {14,
1.7434844383850214`*^-10}, {15, 2.6053424128998922`*^-11}, {16,
9.887095524831592`*^-12}, {17, 1.2318024865446659`*^-12}, {18,
2.2125640342387203`*^-13}, {19, 1.3176590670511745`*^-13}, {20,
2.7354393146500743`*^-14}};
fit = NonlinearModelFit[data, a + b Exp[-x/c], {a, b, c}, x,
MaxIterations -> \[Infinity], PrecisionGoal -> MachinePrecision,
WorkingPrecision -> MachinePrecision];
fit["BestFitParameters"] (* THE WARNING APPEARS AFTER CALLING THIS FUNCTION *)
The warning message is:
FittedModel: The precision of the argument function (MachinePrecision) is less than WorkingPrecision (MachinePrecision).
Thanks in advance.
The problem is that many of the data values are small and close to machine precision. You can try linear fitting to the Log of the data values.
data2 = {First[#], Log[Last[#]]} & /# data;
lm = LinearModelFit[data2, x, x]
Show[ListPlot[data2], Plot[lm[x], {x, 0, 20}]]
The first data point {0, 1} does not look right. Are you sure it is correct?
This is a basic question on list manipulation in Mathematica.
I have a large list where each element has the following schematic form: {List1, List2,Number}. For e.g.,
a = {{{1,2,3},{1,3,2},5},{{1,4,5},{1,0,2},10},{{4,5,3},{8,3,4},15}}}.
I want to make a new lists which only has some parts from each sublist. Eg., pick out the third element from each sublist to give {5,10,15} from the above. Or drop the third element to return {{{1,2,3},{1,3,2}},{{1,4,5},{1,0,2}},{{4,5,3},{8,3,4}}}.
I can do this by using the table command to construct new lists, e.g.,
Table[a[[i]][[3]],{i,1,Length[a]}
but I was wondering if there was a must faster way which would work on large lists.
In Mathematica version 5 and higher, you can use the keyword All in multiple ways to specify a list traversal.
For instance, instead of your Table, you can write
a[[All,3]]
Here Mathematica converts All into all acceptable indices for the first dimension then takes the 3rd one of the next dimension.
It is usually more efficient to do this than to make a loop with the Mathematica programming language. It is really fine for homogenous lists where the things you want to pick or scan through always exist.
Another efficient notation and shortcut is the ;; syntax:
a[[ All, 1 ;; 2]]
will scan the first level of a and take everything from the 1st to the 2st element of each sublist, exactly like your second case.
In fact All and ;; can be combined to any number of levels. ;; can even be used in a way similar to any iterator in Mathematica:
a[[ start;;end;;step ]]
will do the same things as
Table[ a[[i]], {i,start,end,step}]
and you can omit one of start, end or step, it is filled with its default of 1, Length[(of the implicit list)], and 1.
Another thing you might want to lookup in Mathematica's Help are ReplacePart and MapAt that allow programmatic replacement of structured expressions. The key thing to use this efficiently is that in ReplacePart you can use patterns to specify the coordinates of the things to be replaced, and you can define functions to apply to them.
Example with your data
ReplacePart[a, {_, 3} -> 0]
will replace every 3rd part of every sublist with 0.
ReplacePart[a, {i : _, 3} :> 2*a[[i, 3]]]
will double every 3rd part of every sublist.
As the authors suggest, the approaches based on Part need well-formed data, but Cases is built for robust separation of Lists:
Using your a,
a = {{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}};
Cases[a,{_List,_List,n_}:>n,Infinity]
{5, 10, 15}
The other pieces of a record can be extracted by similar forms.
Part-based approaches will gag on ill-formed data like:
badA = {{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}, {baddata}, {{1, 2, 3}, 4}};
badA[[All,3]]
{{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}, {baddata}, {{1, 2, 3},
4}}[[All, 3]]
,but Cases will skip over garbage, operating only on conforming data
Cases[badA, {_List, _List, s_} :> s, Infinity]
{5, 10, 15}
hth,
Fred Klingener
You can use Part (shorthand [[...]]) for this :
a[[All, 3]]
a[[All, {1, 2}]]
For example, I have a list like:
{{1, 2, 3}, {6}, {4, 5}, {1, 6}, {2, 2, 3, 2}, {9}, {7}, {2, 5}}
And I want to get a tallied list based on the total of the lists' elements.
In this case, I want the output to be:
{{6, {{1, 2, 3}, {6}}, {7, {{2, 5}, {1, 6}, {7}}}, {9, {{4, 5}, {2, 2, 3, 2}, {9}}}}}
How to do this conveniently in Mathematica?
Thanks a lot.
Here's my attempt - a little simpler than Yoda's
lst = {{1, 2, 3}, {6}, {4, 5}, {1, 6}, {2, 2, 3, 2}, {9}, {7}, {2, 5}};
{Total#First##, #} & /# GatherBy[lst, Total]
If you don't want repeated elements, then you could use
{Total#First##, Union[#]} & /# GatherBy[lst, Total]
Or if you really wanted a tally-like operation
{Total#First##, Tally[#]} & /# GatherBy[lst, Total]
While I would probably do this just as #Simon did, let us not forget that Reap and Sow can be used as well:
Reap[Sow[#, Total[#]] & /# lst, _, List][[2]]
where lst is the original list. This will be somewhat less efficient than the GatherBy- based code, but also pretty fast. One can speed up the above code about 1.5 times by rewriting it as
Reap[Sow ### Transpose[{lst, Total[lst, {2}]}], _, List][[2]]
in which case it becomes about 1.5 times slower than the code based on GatherBy. Note that the speed difference between the two methods is not very dramatic here, because the list is ragged and therefore not packed, and GatherBy does not have here the speed advantage it normally enjoys for packed arrays.
Don't overlook Tr. This is shorter and faster:
{Tr##, {##}} & ### GatherBy[lst, Tr]
Let’s assume we have a list of elements of the type {x,y,z} for x, y
and z integers. And, if needed x < y < z.
We also assume that the list contains at least 3 such triples.
Can Mathematica easily solve the following problem?
To detect at least one triple of the type {a,b,.}, {b,c,.} and {a,c,.}?
I am more intereseted in an elegant 1-liner than computational efficient solutions.
If I understood the problem, you want to detect triples not necessarily following one another, but generally present somewhere in the list. Here is one way to detect all such triples. First, some test list:
In[71]:= tst = RandomInteger[5,{10,3}]
Out[71]= {{1,1,0},{1,3,5},{3,3,4},{1,2,1},{2,0,3},{2,5,1},{4,2,2},
{4,3,4},{1,4,2},{4,4,3}}
Here is the code:
In[73]:=
Apply[Join,ReplaceList[tst,{___,#1,___,#2,___,#3,___}:>{fst,sec,th}]&###
Permutations[{fst:{a_,b_,_},sec:{b_,c_,_},th:{a_,c_,_}}]]
Out[73]= {{{1,4,2},{4,3,4},{1,3,5}},{{1,4,2},{4,2,2},{1,2,1}}}
This may perhaps satisfy your "one-liner" requirement, but is not very efficient. If you need only triples following one another, then, as an alternative to solution given by #Chris, you can do
ReplaceList[list,
{___, seq : PatternSequence[{a_, b_, _}, {b_, c_, _}, {a_,c_, _}], ___} :> {seq}]
I don't know if I interpreted your question correctly but suppose your list is something like
list = Sort /# RandomInteger[10, {20, 3}]
(*
{{3, 9, 9}, {0, 5, 6}, {3, 4, 8}, {4, 6, 10}, {3, 6, 9}, {1, 4, 8},
{0, 6, 10}, {2, 9, 10}, {3, 5, 9}, {6, 7, 9}, {0, 9, 10}, {1, 7, 10},
{4, 5, 10}, {0, 2, 5}, {0, 6, 7}, {1, 8, 10}, {1, 8, 10}}
*)
then you could do something like
ReplaceList[Sort[list],
{___, p:{a_, b_, _}, ___, q:{a_, c_, _}, ___, r:{b_, c_, _}, ___} :> {p, q, r}]
(* Output:
{{{0, 2, 5}, {0, 9, 10}, {2, 9, 10}}, {{3, 4, 8}, {3, 5, 9},
{4, 5, 10}}, {{3, 4, 8}, {3, 6, 9}, {4, 6, 10}}}
*)
Note that this works since it is given that for any element {x,y,z} in the original list we have x<=y. Therefore, for a triple {{a,b,_}, {a,c,_}, {b,c,_}} \[Subset] list we know that a<=b<=c. This means that the three elements {a,b,_}, {a,c,_}, and {b,c,_} will appear in that order in Sort[list].
To match triples "of the type {a,b,.}, {b,c,.} and {a,c,.}":
list = {{34, 37, 8}, {74, 32, 65}, {48, 77, 18}, {77, 100, 30},
{48, 100, 13}, {100, 94, 55}, {48, 94, 73}, {77, 28, 12},
{90, 91, 51}, {34, 5, 32}};
Cases[Partition[list, 3, 1], {{a_, b_, _}, {b_, c_, _}, {a_, c_, _}}]
(Edited)
(Tuples was not the way to go)
Do you require something like:
list = RandomInteger[10, {50, 3}];
Cases[Permutations[
list, {3}], {{a_, b_, _}, {b_, c_, _}, {a_, c_, _}} /; a < b < c]
giving
{{{0, 1, 2}, {1, 5, 2}, {0, 5, 4}},
{{2, 3, 5},{3, 4, 10}, {2, 4, 5}},
{{6, 8, 10}, {8, 10, 10},{6, 10, 0}},
{{2, 4, 5}, {4, 8, 2}, {2, 8, 5}},
{{2, 4, 5}, {4, 7, 7}, {2, 7, 3}},
{{0, 2, 2}, {2, 7, 3}, {0, 7, 2}},
{{0, 2, 1}, {2, 7, 3}, {0, 7, 2}}}
or perhaps (as other have interpreted the question):
Cases[Permutations[
list, {3}], {{a_, b_, _}, {b_, c_, _}, {a_, c_, _}}];
Suppose I have n=6 distinct monomers each of which has two distinct and reactive ends. During each round of reaction, one random end unites with another random end, either elongates the monomer to a dimer or self-associates into a loop. This reaction process stops whenever no free ends are present in the system. I want to use Mma to simulate the reaction process.
I am thinking to represent the monomers as a list of strings, {'1-2', '3-4', '5-6', '7-8', '9-10', '11-12'}, then to do one round of reacion by updating the content of the list, for example either {'1-2-1', '3-4', '5-6', '7-8', '9-10', '11-12'} or {'1-2-3-4', '5-6', '7-8', '9-10', '11-12'}. But I am not able to go very far due to my programming limitation in Mma. Could anyone please help? Thanks a lot.
Here is the set-up:
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]];
Here is the start:
In[13]:= start = Partition[Range[12], 2]
Out[13]= {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}, {11, 12}}
Here are the steps:
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}}}
Here are the connected components (cycles etc), which you can study:
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}}}
What happens is that we treat all pairs as edges in one big graph, and add an edge randomly if both vertices have at most one connection to some other edge at the moment. At some point, the process stops. Then, we map the componentsBFLS function onto resulting graphs (representing the steps of the simulation), to get the connected components of the graphs (steps). You could use other metrics as well, of course, and write more functions which will analyze the steps for loops etc. Hope this will get you started.
It seems like it would be more natural to represent your molecules as lists rather than strings. So start with {{1,2},{3,4},{5,6}} and so on. Then open chains are just longer lists {1,2,3,4} or whatever, and have some special convention for loops such as starting with the symbol "loop". {{loop,1,2},{3,4,5,6},{7,8}} or whatever.
How detailed does your simulation actually need to be? For instance, do you actually care which monomers end up next to which, or do you only care about the statistics of the lengths of chains? In the latter case, you could greatly simplify the state of your simulation: it could, for instance, consist of a list of loop lengths (which would start empty) and a list of open chain lengths (which would start as a bunch of 1s). Then one simulation step is: pick an open chain at random; with appropriate probabilities, either turn that into a loop or combine it with another open chain.
Mathematica things you might want to look up: RandomInteger, RandomChoice; Prepend, Append, Insert, Delete, ReplacePart, Join; While (though actually some sort of "functional iteration" with, e.g., NestWhile might make for prettier code).
Here's a simple approach. Following the examples given in the question, I've assumed that the monomers have a prefered binding, so that only {1,2} + {3,4} -> {1,2,3,4} OR {1,2,1} + {3,4,3} is possible, but {1,2} + {3,4} -> {1,2,4,3} is not possible. The following code should be packaged up as a nice function/module once you are happy with it. If you're after statistics, then it can also probably be compiled to add some speed.
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]= {}
The loop:
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}}
Edit:
If the monomers can bind at both ends, you just add a option to flip on of the monomers that you join, e.g.
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}}
I see my implementation mimics Simon's closely. Reminder to self: never go to bed before posting solution...
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]
]
Some results: