Solution to exercise plot of the periodic table of alkanes with h value
Solution to exercise plot of the periodic table of alkanes with h value
In[]:=
alkaneisomers=FindIsomers[Molecule[Entity["Chemical","Octane"]]];
In[]:=
Length@alkaneisomers
Out[]=
31
In[]:=
alkanenames=MoleculeName/@alkaneisomers
Out[]=
{octane,2,2,4-trimethylpentane,2-methylheptane,2,2-dimethylhexane,2,4-dimethylhexane,3,3-dimethylhexane,2,3,4-trimethylpentane,2,3-dimethylhexane,4-methylheptane,3-methylheptane,2,3,3-trimethylpentane,3,4-dimethylhexane,2,5-dimethylhexane,2,2,3,3-tetramethylbutane,3-ethyl-2-methyl-pentane,3-ethylhexane,3-ethyl-3-methyl-pentane,2,2,3-trimethylpentane,(3S,4R)-3,4-dimethylhexane,(3R)-3-methylheptane,(3R,4R)-3,4-dimethylhexane,(3R)-2,2,3-trimethylpentane,(3S,4S)-3,4-dimethylhexane,(4S)-2,4-dimethylhexane,(4R)-2,4-dimethylhexane,(3S)-2,2,3-trimethylpentane,(3S)-3-methylheptane,(4S)-3,4-dimethylhexane,(3S)-2,3-dimethylhexane,(3R)-2,3-dimethylhexane,(4R)-3,4-dimethylhexane}
(*Dropstereoisomers*)mols=alkaneisomers[[1;;18]];
(*moleculegraphs*)g=MoleculeGraph[mols,IncludeHydrogensNone,ImageSize->Tiny,VertexStyle->Red,EdgeStyle->Red];
(*Chemicalinformationentropyfromgrouptheoryorbits*)
In[]:=
hchementropy[mol_]:=Module[{nTot,gm,parts,goels,hm},nTot=AtomCount[mol];gm=MoleculeGraph[mol,PlotTheme"IndexLabeled"];goels=Map[Level[AtomList[mol,#],{2}]&,GroupOrbits[GraphAutomorphismGroup[MoleculeGraph[mol,PlotTheme"IndexLabeled"]],Range[1,nTot]]];parts=Map[Counts,goels];hm=N@(Log[2,nTot]-Apply[Plus,MapApply[Plus,Map[#/nTot*Log[2,#]&,Values[parts]]]]);Return[hm]]
In[]:=
hoctane=Map[hchementropy@Molecule@#&,mols]
Out[]=
{2.87314,2.6699,3.53641,3.00663,3.50738,3.43046,2.40142,3.50738,3.07488,3.84411,3.09373,2.81507,2.19969,1.14012,2.96892,3.30565,2.45799,2.97759}
(*foreachisomerenumerateall"paths"accordingdefinitioninRandic'sbook*)
In[]:=
alkanepaths=Map[Table[Length@DeleteDuplicates[Flatten[Table[FindPath[#,i,j,{nn}(*wherenngoesthrough1forsinglebond,2foradjacentbonds,3forthreeadjacentbonds,4forfouradjacentbondsandsoon*)],{i,1,nC},{j,1,nC}],2],(#1==Reverse[#2])&],{nn,1,nC-1,1}]&,g]
Out[]=
{{7,6,5,4,3,2,1},{7,10,5,6,0,0,0},{7,7,5,4,3,2,0},{7,9,5,4,3,0,0},{7,8,6,5,2,0,0},{7,9,7,4,1,0,0},{7,9,8,4,0,0,0},{7,8,7,4,2,0,0},{7,7,6,5,2,1,0},{7,7,6,4,3,1,0},{7,10,9,2,0,0,0},{7,8,8,4,1,0,0},{7,8,5,4,4,0,0},{7,12,9,0,0,0,0},{7,8,8,5,0,0,0},{7,7,7,5,2,0,0},{7,9,9,3,0,0,0},{7,10,8,3,0,0,0}}
(*select(p2,p3)forbuildingperiodictablewithpartialordering*)
In[]:=
alkanepaths23=Map[Table[Length@DeleteDuplicates[Flatten[Table[FindPath[#,i,j,{nn}(*2=adjacentbonds,3=threeadjacentbonds*)],{i,1,nC},{j,1,nC}],2],(#1==Reverse[#2])&],{nn,2,3,1}]&,g]
Out[]=
{{6,5},{10,5},{7,5},{9,5},{8,6},{9,7},{9,8},{8,7},{7,6},{7,6},{10,9},{8,8},{8,5},{12,9},{8,8},{7,7},{9,9},{10,8}}
In[]:=
assocname=AssociationThread[MoleculeName/@mols->alkanepaths23]
Out[]=
octane{6,5},2,2,4-trimethylpentane{10,5},2-methylheptane{7,5},2,2-dimethylhexane{9,5},2,4-dimethylhexane{8,6},3,3-dimethylhexane{9,7},2,3,4-trimethylpentane{9,8},2,3-dimethylhexane{8,7},4-methylheptane{7,6},3-methylheptane{7,6},2,3,3-trimethylpentane{10,9},3,4-dimethylhexane{8,8},2,5-dimethylhexane{8,5},2,2,3,3-tetramethylbutane{12,9},3-ethyl-2-methyl-pentane{8,8},3-ethylhexane{7,7},3-ethyl-3-methyl-pentane{9,9},2,2,3-trimethylpentane{10,8}
In[]:=
boilpointoctaneisom3dec={125.665,117.647,99.238,106.84,109.429,111.969,113.467,115.607,117.709,118.925,114.76,117.725,109.103,106.47,115.145,118.534,118.259,109.841};
In[]:=
databoilpointoctaneisom3dec=Map[Quantity[#,"DegreesCelsius"]&,boilpointoctaneisom3dec]
Out[]=
,,,,,,,,,,,,,,,,,
In[]:=
assocboil=AssociationThread[MoleculeName/@mols->databoilpointoctaneisom3dec]
Out[]=
octane,2,2,4-trimethylpentane,2-methylheptane,2,2-dimethylhexane,2,4-dimethylhexane,3,3-dimethylhexane,2,3,4-trimethylpentane,2,3-dimethylhexane,4-methylheptane,3-methylheptane,2,3,3-trimethylpentane,3,4-dimethylhexane,2,5-dimethylhexane,2,2,3,3-tetramethylbutane,3-ethyl-2-methyl-pentane,3-ethylhexane,3-ethyl-3-methyl-pentane,2,2,3-trimethylpentane
In[]:=
assocmolgraph=AssociationThread[MoleculeName/@mols->g]
Out[]=
octane
,2,2,4-trimethylpentane
,2-methylheptane
,2,2-dimethylhexane
,2,4-dimethylhexane
,3,3-dimethylhexane
,2,3,4-trimethylpentane
,2,3-dimethylhexane
,4-methylheptane
,3-methylheptane
,2,3,3-trimethylpentane
,3,4-dimethylhexane
,2,5-dimethylhexane
,2,2,3,3-tetramethylbutane
,3-ethyl-2-methyl-pentane
,3-ethylhexane
,3-ethyl-3-methyl-pentane
,2,2,3-trimethylpentane
In[]:=
assochoctane=AssociationThread[MoleculeName/@mols->hoctane]
Out[]=
octane2.87314,2,2,4-trimethylpentane2.6699,2-methylheptane3.53641,2,2-dimethylhexane3.00663,2,4-dimethylhexane3.50738,3,3-dimethylhexane3.43046,2,3,4-trimethylpentane2.40142,2,3-dimethylhexane3.50738,4-methylheptane3.07488,3-methylheptane3.84411,2,3,3-trimethylpentane3.09373,3,4-dimethylhexane2.81507,2,5-dimethylhexane2.19969,2,2,3,3-tetramethylbutane1.14012,3-ethyl-2-methyl-pentane2.96892,3-ethylhexane3.30565,3-ethyl-3-methyl-pentane2.45799,2,2,3-trimethylpentane2.97759
In[]:=
Show[{ListPlot[GatherBy[alkanepaths23,#[[2]]&],PlotRange->{{Min[alkanepaths23[[;;,1]]]-1,Max[alkanepaths23[[;;,1]]]},{Min[alkanepaths23[[;;,2]]],Max[alkanepaths23[[;;,2]]]}},PlotStyle{{Black,Thick},{Black,Thick},{Black,Thick}},Joined->True,Axes->True,AxesOrigin{0,-2},Frame->True,FrameLabel->{{"",None},{"",Style["Periodic Table of Octane Constitutional Isomers",18]}},LabelStyle->Directive[Black,12],FrameTicks->{{Range[0,9],Transpose[{Range[0,9],Table[None,{Length[Range[0,9]]}]}]},{Range[0,12],Transpose[{Range[0,12],Table[None,{Length[Range[0,12]]}]}]}}],ListPlot[GatherBy[alkanepaths23,#[[1]]&],LabelingFunction->(Callout[Framed[Column[{IntegerPart@#,Column[{Column[(ii=Extract[Position[assocname,IntegerPart@#],{All,1,1}];ii),Center],Row[Table[assocmolgraph[[ii]][[jj]],{jj,1,Length[ii]}],","],Row[Table[assocboil[[ii]][[jj]],{jj,1,Length[ii]}],","],Row[Table[assochoctane[[ii]][[jj]],{jj,1,Length[ii]}],","]},Center]},Center],Background->Lighter[Gray,0.9],RoundingRadius->5],Center]&),PlotMarkers->{"○","○","○"},PlotRange->{{Min[alkanepaths23[[;;,1]]],Max[alkanepaths23[[;;,1]]]},{Min[alkanepaths23[[;;,2]]],Max[alkanepaths23[[;;,2]]]}},PlotStyle{{Black,Thick},{Black,Thick},{Black,Thick}},Joined->True,Axes->True,Frame->True,FrameTicks->{{Range[-1,9],Transpose[{Range[-1,9],Table[None,{Length[Range[-1,9]]}]}]},{Range[-1,12],Transpose[{Range[-1,12],Table[None,{Length[Range[-1,12]]}]}]}}]},PlotRangePadding->{0.8,0.5},ImageSize->{2500,1000}]
p
3
p
2
Remarks about h values
Remarks about h values