Mathematica繪製元素的周期性質

來自專欄 Mathematica×ChemEdu.6 人贊了文章

元素周期律可以通過三維直方圖來表示，使用mathematica可以很容易的繪製出圖形。繪製三維直方圖在11.3仍沒有相應的內置函數，我們需要使用Graphics3D中的Cuboid（立方體）進行繪圖，並通過Show函數來將其組合。

Cuboid函數的基本用法是Cuboid[{a,b,c},{d,e,f}]，繪畫出從(a,b,c)到(c,d,f)的一個立方體。因此第一步是把原子序數與周期表中的位置對應出來，通過Which循環與自定義函數來定義：

address[f_] := Which[f == 1, {0, 6}, f == 2, {17, 6}, f >= 3 && f <= 4, {f - 3, 5}, f >= 5 && f <= 10, {f + 7, 5}, f >= 11 && f <= 12, {f - 11, 4}, f >= 13 && f <= 18, {f - 1, 4}, f >= 19 && f <= 36, {f - 19, 3}, f >= 37 && f <= 54, {f - 37, 2}, f >= 55 && f <= 57, {f - 55, 1}, f >= 72 && f <= 86, {f - 69, 1}, f >= 87 && f <= 89, {f - 87, 0}, f >= 58 && f <= 71, Null];Table[address[i],{i,100}]

運行結果如下：

{{0, 6}, {17, 6}, {0, 5}, {1, 5}, {12, 5}, {13, 5}, {14, 5}, {15, 5}, {16, 5}, {17, 5}, {0, 4}, {1, 4}, {12, 4}, {13, 4}, {14, 4}, {15, 4}, {16, 4}, {17, 4}, {0, 3}, {1, 3}, {2, 3}, {3, 3}, {4, 3}, {5, 3}, {6, 3}, {7, 3}, {8, 3}, {9, 3}, {10, 3}, {11, 3}, {12, 3}, {13, 3}, {14, 3}, {15, 3}, {16, 3}, {17, 3}, {0, 2}, {1, 2}, {2, 2}, {3, 2}, {4, 2}, {5, 2}, {6, 2}, {7, 2}, {8, 2}, {9, 2}, {10, 2}, {11, 2}, {12, 2}, {13, 2}, {14, 2}, {15, 2}, {16, 2}, {17, 2}, {0, 1}, {1, 1}, {2, 1}, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, {3, 1}, {4, 1}, {5, 1}, {6, 1}, {7, 1}, {8, 1}, {9, 1}, {10, 1}, {11, 1}, {12, 1}, {13, 1}, {14, 1}, {15, 1}, {16, 1}, {17, 1}, {0, 0}, {1, 0}, {2, 0}, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null}

address函數生成的是立方體坐標中的a,b，而c==0，因此第一個坐標我們已經獲得了：

Join[address[i], {0}]

第二個坐標是{a-0.6,b-0.6,ionization}，我們使用自定義函數：

draw[{i_, {m_, n_}}] := {m - 0.6, n - 0.6, QuantityMagnitude[First[ElementData[i, "IonizationEnergies"]]]};Table[draw[{i, address[i]}], {i, 100}]

其中ElementData[i, "IonizationEnergies"]會返回元素的所有的電離能數據，First取第一個數據。隨後 QuantityMagnitude用於去除單位。

運行結果為：

{{-0.6, 5.4, 1312.0}, {16.4, 5.4, 2372.3}, {-0.6, 4.4, 520.2}, {0.4, 4.4, 899.5}, {11.4, 4.4, 800.6}, {12.4, 4.4, 1086.5}, {13.4, 4.4, 1402.3}, {14.4, 4.4, 1313.9}, {15.4, 4.4, 1681.0}, {16.4, 4.4, 2080.7}, {-0.6, 3.4, 495.8}, {0.4, 3.4, 737.7}, {11.4, 3.4, 577.5}, {12.4, 3.4, 786.5}, {13.4, 3.4, 1011.8}, {14.4, 3.4, 999.6}, {15.4, 3.4, 1251.2}, {16.4, 3.4, 1520.6}, {-0.6, 2.4, 418.8}, {0.4, 2.4, 589.8}, {1.4, 2.4, 633.1}, {2.4, 2.4, 658.8}, {3.4, 2.4, 650.9}, {4.4, 2.4, 652.9}, {5.4, 2.4, 717.3}, {6.4, 2.4, 762.5}, {7.4, 2.4, 760.4}, {8.4, 2.4, 737.1}, {9.4, 2.4, 745.5}, {10.4, 2.4, 906.4}, {11.4, 2.4, 578.8}, {12.4, 2.4, 762.}, {13.4, 2.4, 947.0}, {14.4, 2.4, 941.0}, {15.4, 2.4, 1139.9}, {16.4, 2.4, 1350.8}, {-0.6, 1.4, 403.0}, {0.4, 1.4, 549.5}, {1.4, 1.4, 6.0*10^2}, {2.4, 1.4, 640.1}, {3.4, 1.4, 652.1}, {4.4, 1.4, 684.3}, {5.4, 1.4, 702.}, {6.4, 1.4, 710.2}, {7.4, 1.4, 719.7}, {8.4, 1.4, 804.4}, {9.4, 1.4, 731.0}, {10.4, 1.4, 867.8}, {11.4, 1.4, 558.3}, {12.4, 1.4, 708.6}, {13.4, 1.4, 834.}, {14.4, 1.4, 869.3}, {15.4, 1.4, 1008.4}, {16.4, 1.4, 1170.4}, {-0.6, 0.4, 375.7}, {0.4, 0.4, 502.9}, {1.4, 0.4, 538.1}, draw[{58, Null}], draw[{59, Null}], draw[{60, Null}], draw[{61, Null}], draw[{62, Null}], draw[{63, Null}], draw[{64, Null}], draw[{65, Null}], draw[{66, Null}], draw[{67, Null}], draw[{68, Null}], draw[{69, Null}], draw[{70, Null}], draw[{71, Null}], {2.4, 0.4, 658.5}, {3.4, 0.4, 761.}, {4.4, 0.4, 770.}, {5.4, 0.4, 760.}, {6.4, 0.4, 840.}, {7.4, 0.4, 880.}, {8.4, 0.4, 870.}, {9.4, 0.4, 890.1}, {10.4, 0.4, 1007.1}, {11.4, 0.4, 589.4}, {12.4, 0.4, 715.6}, {13.4, 0.4, 703.}, {14.4, 0.4, 812.1}, {15.4, 0.4, 920.}, {16.4, 0.4, 1037.}, {-0.6, -0.6, 380.}, {0.4, -0.6, 509.3}, {1.4, -0.6, 499.}, draw[{90, Null}], draw[{91, Null}], draw[{92, Null}], draw[{93, Null}], draw[{94, Null}], draw[{95, Null}], draw[{96, Null}], draw[{97, Null}], draw[{98, Null}], draw[{99, Null}], draw[{100, Null}]}

可以看出，由於鑭系金屬我們沒有考慮，因此有一些數據為Null，在最後繪圖的過程中需要刪除。通過If函數可以簡單的刪除鑭系（當然更簡單的方法是Table的取值中不包括鑭系）

If[Length[address[i]] == 2, (Cuboid[Join[address[i], {0}], draw[{i, address[i]}]]), Null]

如果address[i]返回的結果不是Null的話，就是一個二元數組。Length返回結果是2。最後繪圖：

Show@Graphics3D[ Table[If[Length@address[i] == 2, (Cuboid[Join[address[i], {0}], draw[{i, address[i]}]]), Null], {i, 88}], BoxRatios -> {18, 7, 6}, ViewPoint -> {50, -150, 100}, Boxed -> False, Axes -> {False, False, True}, AxesEdge -> {1, 1}]

結果為：