Message Boards Message Boards

GROUPS:

PSE in the classroom

Posted 9 months ago
773 Views
|
0 Replies
|
3 Total Likes
|

First we set up the elements:

PSEelements[list_, col_] := 
 Map[Item[Style[#, FontFamily -> "Ink Free"], Background -> col, 
    Frame -> Black] &, list]
s = LightRed; p = LightYellow; d = LightBlue; f = LightGreen;
S1 = PSEelements[{"H", "He"}, s];
S2 = PSEelements[{"Li", "Be"}, s];
P2 = PSEelements[{"B", "C", "N", "O", "F", "Ne"}, p];
S3 = PSEelements[{"Na", "Mg"}, s];
P3 = PSEelements[{"Al", "Si", "P", "S", "Cl", "Ar"}, p];
S4 = PSEelements[{"K", "Ca"}, s];
P4 = PSEelements[{"Ga", "Ge", "As", "Se", "Br", "Kr"}, p];
S5 = PSEelements[{"Rb", "Sr"}, s];
P5 = PSEelements[{"In", "Sn", "Sb", "Te", "I", "Xe"}, p];
S6 = PSEelements[{"Cs", "Ba"}, s];
P6 = PSEelements[{"Tl", "Pb", "Bi", "Po", "At", "Rn"}, p];
S7 = PSEelements[{"Fr", "Ra"}, s];
P7 = PSEelements[{"Nh", "Fl", "Mc", "Lv", "Ts", "Og"}, p];
D3 = PSEelements[{"Sc", "Ti", "V", "Cr", "Mn", "Fe", "Co", "Ni", "Cu",
     "Zn"}, d];
D4 = PSEelements[{"Y", "Zr", "Nb", "Mo", "Tc", "Ru", "Rh", "Pd", "Ag",
     "Cd"}, d];
D5 = PSEelements[{"La", "Hf", "Ta", "W", "Re", "Os", "Ir", "Pt", "Au",
     "Hg"}, d];
D6 = PSEelements[{"Ac", "Rf", "Db", "Sg", "Bh", "Hs", "Mt", "Ds", 
    "Rg", "Cn"}, d];
F4 = PSEelements[{"Ce", "Pr", "Nd", "Pm", "Sm", "Eu", "Gd", "Tb", 
    "Dy", "Ho", "Er", "Tm", "Yb", "Lu"}, f];
F5 = PSEelements[{"Th", "Pa", "U", "Np", "Pu", "Am", "Cm", "Bk", "Cf",
     "Es", "Fm", "Md", "No", "Lr"}, f];
all = Join[S1, S2, P2, S3, P3, S4, D3, P4, S5, D4, P5, S6, D5, F4, P6,
    S7, D6, F5, P7];

Then a simple eight column PSE is constructed (highlighting H an He):

Grid[PSE8 = {Join[{First[S1]}, Table["", 6], {Last[S1]}], 
   Join[S2, P2], Join[S3, P3], Join[S4, P4], Join[S5, P5], 
   Join[S6, P6]}, Spacings -> {1, 1}, 
 ItemStyle -> {Automatic, 
   Automatic, {{1, 1} -> Directive[Bold, Blue], {1, 8} -> 
     Directive[Bold, Blue]}}]

Which gives:

enter image description here

And now highlighting the Alkaline earth elements:

Grid[PSE8, 
 ItemStyle -> {Automatic, Automatic, 
   Table[{i, 2} -> Directive[Bold, Blue], {i, 2, 7}]}]

Looks like:

enter image description here

Here we have a standard 18 column PSE with ferromagnetic elements highlighted:

Grid[PSE18 = {Join[{S1[[1]]}, Table["", 6 + 10], {S1[[2]]}], 
   Join[S2, Table["", 10], P2], Join[S3, Table["", 10], P3], 
   Join[S4, D3, P4], Join[S5, D4, P5], Join[S6, D5, P6], 
   Join[S7, D6, P7]}, 
 ItemStyle -> {Automatic, Automatic, 
   Table[{4, i} -> Directive[Bold, Blue], {i, 8, 10}]}]

gives:

enter image description here

A full PSE with still 18 columns and all elements without stable isotope marked:

Grid[PSE18full = 
  Join[PSE18, {Table["", 6 + 10 + 14], Join[Table["", 3], F4], 
    Join[Table["", 3], F5]}], 
 ItemStyle -> {Automatic, Automatic, 
   Join[{{5, 7} -> Directive[Red, Bold], {9, 7} -> 
      Directive[Red, Bold]}, 
    Table[{6, i} -> Directive[Red, Bold], {i, 15, 18}], 
    Table[{7, i} -> Directive[Red, Bold], {i, 1, 18}], 
    Table[{10, i} -> Directive[Red, Bold], {i, 4, 17}]]}]

I never noticed before that there is no stable isotope for Pm:

enter image description here

alternatively:

Grid[{Join[{S1[[1]]}, Table["", 6 + 10], {S1[[2]]}], 
  Join[S2, Table["", 10], P2], Join[S3, Table["", 10], P3], 
  Join[S4, D3, P4], Join[S5, D4, P5], Join[S6, {""}, Rest[D5], P6], 
  Join[S7, {""}, Rest[D6], P7], Table["", 6 + 10 + 14], 
  Join[Table["", 2], {First[D5]}, F4], 
  Join[Table["", 2], {First[D6]}, F5]}, 
 ItemStyle -> {Automatic, Automatic, 
   Join[{{5, 7} -> Directive[Red, Bold], {9, 7} -> 
      Directive[Red, Bold]}, 
    Table[{6, i} -> Directive[Red, Bold], {i, 15, 18}], 
    Table[{7, i} -> Directive[Red, Bold], {i, 1, 18}], 
    Table[{10, i} -> Directive[Red, Bold], {i, 3, 17}]]}]

gives:

enter image description here

and a 32 column layout:

Grid[PSE32 = {Join[{S1[[1]]}, Table["", 6 + 10 + 14], {S1[[2]]}], 
   Join[S2, Table["", 10 + 14], P2], Join[S3, Table["", 10 + 14], P3],
    Join[S4, {First[D3]}, Table["", 14], Rest[D3], P4], 
   Join[S5, {First[D4]}, Table["", 14], Rest[D4], P5], 
   Join[S6, {First[D5]}, F4, Rest[D5], P6], 
   Join[S7, {First[D6]}, F5, Rest[D6], P7]}, Spacings -> {0.5, 0.5}, 
 ItemStyle -> {Automatic, Automatic, 
   Join[{{5, 21} -> Directive[Red, Bold], {6, 7} -> 
      Directive[Red, Bold]}, 
    Table[{6, i} -> Directive[Red, Bold], {i, 29, 32}], 
    Table[{7, i} -> Directive[Red, Bold], {i, 1, 32}], 
    Table[{10, i} -> Directive[Red, Bold], {i, 4, 17}]]}]

gives:

enter image description here

and finally a more artistic PSE view:

r = 0.3; Graphics[{
  (*n=1*)
  Circle[{0, 0}, 1], 
  shell = CirclePoints[2]; {LightRed, EdgeForm[Black], 
   Map[Disk[#, r] &, shell]}, {MapIndexed[Text[all[[#2[[1]]]], #1] &, 
    shell]},
  (*n=2*)
  Circle[{0, 0}, 2], 
  shell = CirclePoints[{2, 0 \[Degree]}, 8]; {LightRed, 
   EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, 
   Map[Disk[#, r] &, Take[shell, -6]]}, {MapIndexed[
    Text[all[[#2[[1]] + 2]], #1] &, shell]},
  (*n=3*)
  Circle[{0, 0}, 3], 
  shell = CirclePoints[{3, 0 \[Degree]}, 8]; {LightRed, 
   EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, 
   Map[Disk[#, r] &, Take[shell, -6]]}, {MapIndexed[
    Text[all[[#2[[1]] + 2 + 8]], #1] &, shell]},
  (*n=4*)
  Circle[{0, 0}, 4], 
  shell = CirclePoints[{4, 0 \[Degree]}, 18]; {LightRed, 
   EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, 
   Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, 
   Map[Disk[#, r] &, Take[shell, -10]]}, {MapIndexed[
    Text[all[[#2[[1]] + 2 + 2 8]], #1] &, shell]},
  (*n=5*)
  Circle[{0, 0}, 5], 
  shell = CirclePoints[{5, 0 \[Degree]}, 18]; {LightRed, 
   EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, 
   Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, 
   Map[Disk[#, r] &, Take[shell, -10]]}, {MapIndexed[
    Text[all[[#2[[1]] + 2 + 2 8 + 18]], #1] &, shell]},
  (*n=6*)
  Circle[{0, 0}, 6], 
  shell = CirclePoints[{6, 0 \[Degree]}, 32]; {LightRed, 
   EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, 
   Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, 
   Map[Disk[#, r] &, Take[shell, {9, 18}]], LightGreen, 
   Map[Disk[#, r] &, Take[shell, -14]]}, {MapIndexed[
    Text[all[[#2[[1]] + 2 + 2 8 + 2 18]], #1] &, shell]},
  (*n=7*)
  Circle[{0, 0}, 7], 
  shell = CirclePoints[{7, 0 \[Degree]}, 32]; {LightRed, 
   EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, 
   Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, 
   Map[Disk[#, r] &, Take[shell, {9, 18}]], LightGreen, 
   Map[Disk[#, r] &, Take[shell, -14]]}, {MapIndexed[
    Text[all[[#2[[1]] + 2 + 2 8 + 2 18 + 32]], #1] &, shell]}}]

PSE in circles:

enter image description here

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract