Potential Energy Surfaces (PES)

Theme Parks and Slides

WaterWorld, Lloret de Mar

funnelsito=Log[f^2+g^2]
funnelmatrix=Table[Table[{f,g,funnelsito},{f,-1,1,0.1}],{g,-1,1,0.1}];
funnelplot=Plot3D[Log[f^2+g^2],{f,-1,1},{g,-1,1},ColorFunction->"DeepSeaColors",Mesh->None,AxesLabel->{"x","y","Height"},ImageSize->Large];

funnelpositionS1=RandomInteger[{1,Length[funnelmatrix]},5];
funnelpositionS2=RandomInteger[{1,Length[funnelmatrix]},5];
funnelist=Partition[Riffle[funnelpositionS1,funnelpositionS2],2];
funnelcolor=RandomColor[Length[funnelist]];

transitionfunnel[{index1_,index2_}, stairs_,temperature_]:=
Module[
{
attempt1,
attempt2,  (*the new position to attempt*)
deltaEnergy,
boltzmannTerm
},
attempt1 = Mod[index1+ RandomChoice[{-1,1}],Length[funnelmatrix],1]; 

attempt2=Mod[index2+ RandomChoice[{-1,1}],Length[funnelmatrix],1];
(*pick a random sign in both directions and then use Mod to make sure that if the position moves off the end at x=1, it will appear at the beginnig at x=0*)
deltaEnergy = Last[stairs[[attempt1,attempt2]]]- Last[stairs[[index1,index2]]];
If[deltaEnergy≤ 0, Return[{attempt1,attempt2}]];
boltzmannTerm = Exp[-deltaEnergy/temperature];
(*Many ways to do this, a weighted random choice is intuitive*)
RandomChoice[{boltzmannTerm,1-boltzmannTerm}-> {{attempt1,attempt2},{index1,index2}}]
]

Dynamic[Show[{funnelplot},{Graphics3D[{PointSize[0.03],Point/@Partition[Flatten[Table[{funnelmatrix[[First[funnelist[[n]]],Last[funnelist[[n]]]]]},{n,1,Length[funnelist],1}]],3]}]}]]

Do[funnelist=transitionfunnel[#,funnelmatrix,0.1]&/@funnelist;Pause[0.01],10]

Knowing our statistics

dx=.015;
stairpotential[x_]:=x
discretestairpotential=Table[{a,stairpotential[a]},{a,0,.06,dx}]; 
Grid[{{Text[Style["P↓=1",FontSize->20]],Text[Style["P↑=(e^((-(Energy2 - Energy1))/(k·T)))",FontSize->20]]}},Frame->All]

Show[Graphics[{Arrow[{{0.04,0.015},{0.04,0.03}}],Text[Style["   Upper State",FontSize->Medium,FontFamily->"Calibri Light"],{0.042,0.048}],Text[Style["   Initial State",FontSize->Medium,FontFamily->"Calibri Light"],{0.027,0.033}],Text[Style["   Lower State",FontSize->Medium,FontFamily->"Calibri Light"],{0.012,0.018}],Text[Style["   mgh",FontSize->Large,FontFamily->"Calibri Light"],{0.046,0.022}]},Axes->True,AxesLabel->{"Coordinate1","Energy"}, AxesOrigin->{-.01,0},AxesStyle->Directive[Opacity[0.7],Thin]],Plot[stairpotential[x],{x,0,.06},PlotStyle->Opacity[0.5],ImageSize->Medium],Graphics[{Red,Line[Partition[Flatten[{{First[#]-dx/2,Last[#]},{First[#]+dx/2,Last[#]}}&/@discretestairpotential],2]]},ImageSize->Medium]]

Grid[{{Show[Graphics[{PointSize[0.2],Blue,Point/@{{0,0},{1,1},{2,2}}},ImageSize->Medium],Graphics[{Red,Arrow[{{0.8,0.8},{0.2,0.2}}]}],Graphics[{Red,Arrow[{{1.2,1.2},{1.8,1.8}}]}]],Show[Graphics3D[{PointSize[0.2],Purple,Point/@Cases[Tuples[{1,0,2},3],{1,_,_}]},Boxed->False,ViewPoint->{2, -1, -2},ImageSize->Medium],Graphics3D[{Red,Arrow[{{1,1,1},{1,1,0}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,0,1}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,0,0}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,2,1}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,1,2}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,0,2}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,2,0}}]}],Graphics3D[{Red,Arrow[{{1,1,1},{1,2,2}}]}]]}}]

Case 1: Transition States

Triatomic hypothetic molecules (e.g, H-H-F)

lenardjones=1/r^12-2/r^6

Show[{Plot[lenardjones,{r,0.8,1.6},PlotLabel->"Lenard Jones Potential",AxesLabel->{"Normalized Distance","Energy"},ImageSize->Large]},{Graphics[{Line[{{.98,-.75},{1.05,-.75}}],PointSize[0.04],RGBColor[0.5,0.5,0.85],Point[{{.98,-.75},{1.05,-.75}}]}]},
{Graphics[{PointSize[0.04],RGBColor[0.5,0.5,0.85],Point[{{1.4,-.5},{1.57,-.5}}]}]},
{Graphics[{PointSize[0.04],RGBColor[0.5,0.5,0.85],Point[{{0.9,0.7},{0.92,0.7}}]}]}
]

points=Graphics[Partition[Riffle[Flatten[Transpose[{{RGBColor[0.5,0.5,0.85],RGBColor[0.5,0.5,0.85],RGBColor[0.93,0.5,0.5]},Point/@{{0,0},{1,0},{2,0}}}]],PointSize[0.2],{1,-1,3}],3]];
line1=Graphics[{Text[H,{1,-0.3}],Text[F,{2,-0.3}],Text[H,{0,-0.3}],Line[{{0,0},{1,0}}]}];
line2=Graphics[{Text[H,{1,-0.3}],Text[F,{2,-0.3}],Text[H,{0,-0.3}],Line[{{0,0},{2,0}}]}];
line3=Graphics[{Text[H,{1,-0.3}],Text[F,{2,-0.3}],Text[H,{0,-0.3}],Line[{{1,0},{2,0}}]}];
Grid[{{"H2 + F","TRANSITION STATE (H-H-F)","HF + H"},{Show[line1,points,ImageSize->Medium],Show[line2,points,ImageSize->Medium],Show[line3,points,ImageSize->Medium]}},Frame->All]

potentialsurface=1/r^12-2/r^6+1/d^12-2/d^6-(2 Exp[-(r-d)]+2Exp[-(d-r)]-2 Exp[-(2 (r-d)-2(d-r))*Cos[d]]);
niceplot=Plot3D[potentialsurface,{r,0.8,1.6},{d,0.8,1.6},ColorFunction->"LakeColors",ImageSize->Medium,PlotLabel->"Continuous PES",AxesLabel->{"H-H distance","H-F distance","Energy"}, Mesh->None,BoxRatios->{1, 1, 1},ViewPoint->{1.5, 2.4, 3}];
contour=Show[ContourPlot[potentialsurface,{r,.8,1.6},{d,.8,1.6},Contours->15,ColorFunction->"LakeColors",ImageSize->Medium,PlotLabel->"Contour PES Plot",ContourStyle->None],Graphics[Text["H-H-F",{1.04,1.31}]]];
pointplot=ListPointPlot3D[Table[Table[{r,d,potentialsurface},{r,.8,1.6,0.03}],{d,.8,1.6,0.03}],ColorFunction->"LakeColors",Filling->Bottom,ImageSize->Medium,Boxed->False,BoxRatios->{1, 1, 1},AxesLabel->{"H-H distance","H-F distance","Energy"},PlotLabel->"Discrete PES",ViewPoint->{1.3, 2.4, 3}];
pointito=Graphics3D[Red,Point[{1.6,1.6,1}]];
alltogether=Show[pointito,niceplot];
graphicinformation=Grid[{{contour,niceplot,pointplot}},Frame->True]

potentialmatrix=Table[Table[{r,d,potentialsurface},{r,.8,1.6,0.03}],{d,.8,1.6,0.03}];
matrixview=MatrixForm[potentialmatrix];

pointsomewhere=Manipulate[Show[Graphics3D[{PointSize[0.04],Red,Point[potentialmatrix[[Bond1,Bond2]]]},BoxRatios->{1, 1, 1},Boxed->False,ViewPoint->{1.5, 2.4, 3}],Plot3D[potentialsurface,{r,0.8,1.55},{d,0.8,1.55},ColorFunction->"LakeColors",BoxRatios->{1, 1, 1},Boxed->False,Mesh->None]],{Bond1,4,26,1},Delimiter,{Bond2,4,26,1}]

pestransitionDual[{index1_,index2_}, stairs_, temperature_]:=
Module[
{
attempt1,
attempt2,  (*the new position to attempt*)
deltaEnergy,
boltzmannTerm
},
attempt1 = Mod[index1+ RandomChoice[{-1,1}],Length[potentialmatrix],1]; 

attempt2=Mod[index2+ RandomChoice[{-1,1}],Length[potentialmatrix],1];
(*pick a random sign in both directions and then use Mod to make sure that if the position moves off the end at x=1, it will appear at the beginnig at x=0*)
deltaEnergy = Last[stairs[[attempt1,attempt2]]]- Last[stairs[[index1,index2]]];
If[deltaEnergy≤ 0, Return[{attempt1,attempt2}]];
boltzmannTerm = Exp[-deltaEnergy/temperature];
(*Many ways to do this, a weighted random choice is intuitive*)
RandomChoice[{boltzmannTerm,1-boltzmannTerm}-> {{attempt1,attempt2},{index1,index2}}]
]

Grid[{{Manipulate[
startingpositionS1=RandomInteger[{1,Length[potentialmatrix]},n];
startingpositionS2=RandomInteger[{1,Length[potentialmatrix]},n];
partylist=Partition[Riffle[startingpositionS1,startingpositionS2],2];
Length[partylist],
{{n,2,Style["Number of particles",FontSize->16]},2,1000,1}]},

{DynamicModule[
{niceplot=Plot3D[potentialsurface,{r,0.8,1.6},{d,0.8,1.6},ColorFunction->"LakeColors",ImageSize->Medium,PlotLabel->"Continuous PES",AxesLabel->{"r distance","d distance","Energy"}, Mesh->None,BoxRatios->{1, 1, 1},ViewPoint->{1.3, 2.4, 3},Lighting->{{"Ambient", LightBlue}}]},
Manipulate[
colors3=RandomColor[Length[partylist]];
While[Go,Pause[slowness];partylist=pestransitionDual[#,potentialmatrix,Temperature]&/@partylist;];
Row[{Dynamic[Show[{niceplot},{Graphics3D[{PointSize[0.03],Transpose[{colors3,Point/@Partition[Flatten[Table[{potentialmatrix[[First[partylist[[n]]],Last[partylist[[n]]]]]},{n,1,Length[partylist],1}]],3]}]}]}]],

Dynamic[Histogram3D[partylist,ImageSize->Medium,ChartElementFunction->"GradientScaleCube",ChartBaseStyle->EdgeForm[None],ViewPoint->{1.3, 2.4, 3}]]}],
{{Go,False,""},{False-> Style["Stop",FontSize->13],True-> Style["Simulate",FontSize->13]}},
Delimiter,
{{Temperature,.1,Style["Temperature",FontSize->16]},0.1, 10},
Delimiter,
{{slowness,.1,Style["Computation Speed",FontSize->16]},{0->"Fast",.1->"Medium",.2 -> "Slow"}}
]
]}}
,Alignment->Right]

anna.morales@epfl.ch

Case 2: The Folding Funnel

funnyfunnel=(x^2)/4+4*Sin[x]+6*Cos[2x]+2*Sin[3x]+(y^2)/4+2*Sin[3+y]+3*Cos[2y]+2*Sin[3y]+2*Sin[4y];
niceplot2=Plot3D[(x^2)/4+4*Sin[x]+6*Cos[2x]+2*Sin[3x]+(y^2)/4+2*Sin[3+y]+3*Cos[2y]+2*Sin[3y]+2*Sin[4y],{x,-10,10},{y,-10,10},ColorFunction->"FuchsiaTones",BoxRatios->{1, 1, 1},ImageSize->Medium,ViewPoint->{1, -2, 1},Mesh->None];
contour=ContourPlot[funnyfunnel,{x,-10,10},{y,-10,10},Contours->15,ColorFunction->"FuchsiaTones",ImageSize->Medium,PlotLabel->"Contour PES Plot",ContourStyle->None];pointplot2=ListPointPlot3D[Table[Table[{x,y,funnyfunnel},{x,-10,10,.5}],{y,-10,10,.5}],ColorFunction->"FuchsiaTones",Filling->Bottom,ImageSize->Medium,Boxed->False,BoxRatios->{1, 1, 1},AxesLabel->{"blep","blop","Energy"},PlotLabel->"Discrete Funny Funnel",ViewPoint->{1.3, 2.4, 3}];
graphicinformation2=Grid[{{contour,niceplot2,pointplot2}},Frame->True]

potentialmatrix2=Table[Table[{x,y,funnyfunnel},{x,-10,10,1}],{y,-10,10,1}];
matrixview2=MatrixForm[potentialmatrix2];

pestransitionfunnel[{index1_,index2_}, stairs_, temperature_]:=
Module[
{
attempt1,
attempt2,  (*the new position to attempt*)
deltaEnergy,
boltzmannTerm
},
attempt1 = Mod[index1+ RandomChoice[{-1,1}],Length[potentialmatrix2],1]; 

attempt2=Mod[index2+ RandomChoice[{-1,1}],Length[potentialmatrix2],1];
(*pick a random sign in both directions and then use Mod to make sure that if the position moves off the end at x=1, it will appear at the beginnig at x=0*)
deltaEnergy = Last[stairs[[attempt1,attempt2]]]- Last[stairs[[index1,index2]]];
If[deltaEnergy≤ 0, Return[{attempt1,attempt2}]];
boltzmannTerm = Exp[-deltaEnergy/temperature];
(*Many ways to do this, a weighted random choice is intuitive*)
RandomChoice[{boltzmannTerm,1-boltzmannTerm}-> {{attempt1,attempt2},{index1,index2}}]
]

Grid[{{Manipulate[
startingpositionS12=RandomInteger[{1,Length[potentialmatrix2]},t];
startingpositionS22=RandomInteger[{1,Length[potentialmatrix2]},t];
partylist2=Partition[Riffle[startingpositionS12,startingpositionS22],2];
Length[partylist2],
{{t,2,Style["Number of particles",FontSize->16]},2,1000,1}]},

{DynamicModule[
{niceplot2=Plot3D[funnyfunnel,{x,-10,10},{y,-10,10},ColorFunction->"FuchsiaTones",ImageSize->Medium,PlotLabel->"Continuous PES",AxesLabel->{"coordinate x","coordinate y","Energy"}, Mesh->None,BoxRatios->{1, 1, 1},ViewPoint->{1.3, 2.4, 3},Lighting->{{"Ambient", LightBlue}}]},
Manipulate[
colors3=RandomColor[Length[partylist2]];
While[Go,Pause[slowness];partylist2=pestransitionfunnel[#,potentialmatrix2,Temperature]&/@partylist2;];
Row[{Dynamic[Show[{niceplot2},{Graphics3D[{PointSize[0.03],Transpose[{colors3,Point/@Partition[Flatten[Table[{potentialmatrix2[[First[partylist2[[t]]],Last[partylist2[[t]]]]]},{t,1,Length[partylist2],1}]],3]}]}]}]],

Dynamic[Histogram3D[partylist2,ChartElementFunction->"GradientScaleCube",ImageSize->Medium,ChartBaseStyle->EdgeForm[None],ViewPoint->{1.3, 2.4, 3}]]}],
{{Go,False,""},{False-> Style["Stop",FontSize->13],True-> Style["Simulate",FontSize->13]}},
Delimiter,
{{Temperature,.1,Style["Temperature",FontSize->16]},0.1, 10},
Delimiter,
{{slowness,.1,Style["Computation Speed",FontSize->16]},{0->"Fast",.1->"Medium",.2 -> "Slow"}}
]
]}}
,Alignment->Right]

anna.morales@epfl.ch