Creating 3D Printed periodic tables with Mathematica

Introduction

The purpose of this Mathematica notebook is to introduce the reader to the Periodic Trends package and how it can be used to create objects for 3D printing.  Following this introduction, there are three sections.  The first is Initialization.  This code needs to be run every time Mathematica is started.  It should run automatically.  An error will be thrown if this notebook is not in the same directory as the Periodic Trends package (the file named PTrends.wl).

There are to main functions in the Periodic Trends package.  The first is getInfo, which is used for obtaining the periodic trend of interest, processing the data if necessary, and rescaling the values to a 3D printable range.

The second function is makeSTL which generates the periodic table object.  Typically, the user can modify the overall size of the final object and characteristics of the base.  Additionally, the function createText is used to create titles for the objects.

Once an object has been created, it is Exported as an STL file, which can be read by most, if not all, contemporary 3D printers.  

The Basic tables section provides information on how to create the four general trends that are typically discussed in General Chemistry.  In each case, four different sizes and styles are generated in order to demonstrate some of the capabilities of the package.  In the Advance tables section, several examples are shown that demonstrate processing of data, combining datasets and loading an external trend from a spreadsheet file.

Please note that generating the tables may take some time.  On a fairly recent desktop, the objects can take upwards of a minute to generate.  If you are using a Rasbperry Pi, they will take significantly longer.   That said, all 20 of the objects generated in the examples below can be created on the Raspberry Pi (model 2B) within 30 minutes.

Initialization

SetDirectory@NotebookDirectory[];
$filename = "PTrends.wl";
If[FileExistsQ[$filename],Get@$filename,Echo[$filename, "File was not found."];]

Basic tables

Atomic Radius

Creates a periodic table object with dimensions 150x54x21 (mm^3).  No title is included on the base.  No f-block is displayed.  The exported object requires approximately 3 hours to print.

data = getInfo["AtomicRadius"];
object = makeSTL[data];
Export[FileNameJoin[{$HomeDirectory,"atomic-radius-150x21mm-no-title.stl"}],object];

Creates a periodic table object with dimensions 132x76x13 (mm^3) including the f-block and a title.  Title scaling is a trial-and-error process.  A good starting point is 0.02 and adjusting from there.  A good starting point for the position is {2, 3.5 , 0} times the size of the element blocks.  The exported object requires approximately 3 hours to print.

data = getInfo["AtomicRadius",minHeight->0., maxHeight->10., keepMissing->True,fullTable->True]/._Missing:>0.;
title = createText["Atomic Radius",1.5,0.1,position->7{2,3.5,0}];
object=makeSTL[data,blockSize->7];
Export[
FileNameJoin[{$HomeDirectory,"atomic-radius-132x76mm-title.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

Creates a periodic table with dimensions 108x36x12 (mm^3) .  No title and no base. No f-block.  At this point, these settings generate the smallest/quickest periodic table that contains (reasonably) legible  text.  Requires 1.25 hours to print.

data = getInfo["AtomicRadius",minHeight->1.,maxHeight->10.];
object=makeSTL[data,blockSize->6,includeBase->False];
Export[FileNameJoin[{$HomeDirectory,"atomic-radius-108x36mm-no-base.stl"}],object];

Create a small “flash-card” size object with no element text and no title.  Dimensions are 60x24x11 and takes 25 minutes to print.

data = getInfo["AtomicRadius",minHeight->0.3,maxHeight->10.];
object=makeSTL[data,blockSize->3,noText->True];
Export[FileNameJoin[{$HomeDirectory,"atomic-radius-60x24mm.stl"}],object];

Electronegativity

The procedures for making periodic tables with electronegativity trends are identical to those used to create the atomic radii tables.  In Version 11.3 of Mathematica, a bug was introduced that results in some periodic table configurations being poorly formed.  Depending on the 3D printer software, it may not be a problem, since the issues can be automatically repaired.  If not, however, free services such as https://service.netfabb.com/service.php can be used to repair STL files.  All of the tables below were cleaned in this fashion prior to printing.  Of the four basic tables, only objects with electronegativity trends needed to be repaired in this fashion.

data = getInfo["Electronegativity"];
object = makeSTL[data];
Export[FileNameJoin[{$HomeDirectory,"electronegativity-150x21mm-no-title.stl"}],object];

Full table, including f-block and a title.

data = getInfo["Electronegativity",minHeight->0., maxHeight->10., keepMissing->True,fullTable->True]/._Missing:>0.;
title = createText["Electronegativity",1.5,0.1,position->7{2,3.5,0}];
object=makeSTL[data,blockSize->7];

Before exporting the object, it can be previewed to ensure the text is in the correct position

Show[{object,title}]

Export[
FileNameJoin[{$HomeDirectory,"electronegativity-132x76mm-title.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

No base version

data = getInfo["Electronegativity",minHeight->1.,maxHeight->10.];
object=makeSTL[data,blockSize->6,includeBase->False];
Export[FileNameJoin[{$HomeDirectory,"electronegativity-108x36mm-no-base.stl"}],object];

Flash-card version

data = getInfo["Electronegativity",minHeight->0.3,maxHeight->10.];
object=makeSTL[data,blockSize->3,noText->True];
Export[FileNameJoin[{$HomeDirectory,"electronegativity-60x24mm.stl"}],object];

Electron affinity

data = getInfo["ElectronAffinity"];
object = makeSTL[data];
Export[FileNameJoin[{$HomeDirectory,"electronaffinity-150x21mm-no-title.stl"}],object];

Full table, including f-block and a title.

data = getInfo["ElectronAffinity",minHeight->0., maxHeight->10., keepMissing->True,fullTable->True]/._Missing:>0.;
title = createText["Electron Affinity",1.5,0.1,position->7{2,3.5,0}];
object=makeSTL[data,blockSize->7];

Export[
FileNameJoin[{$HomeDirectory,"electronaffinity-132x76mm-title.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

No base version

data = getInfo["ElectronAffinity",minHeight->1.,maxHeight->10.];
object=makeSTL[data,blockSize->6,includeBase->False];
Export[FileNameJoin[{$HomeDirectory,"electronaffinity-108x36mm-no-base.stl"}],object];

Flash-card version

data = getInfo["ElectronAffinity",minHeight->0.3,maxHeight->10.];
object=makeSTL[data,blockSize->3,noText->True];
Export[FileNameJoin[{$HomeDirectory,"electronaffinity-60x24mm.stl"}],object];

Ionization Energy

Of the standard periodic trends commonly mentioned in the General Chemistry curriculum, ionization energy is the “hardest” to print.  The Mathematica’s element dataset contains all known ionization energies for each element in a list.  Therefore, the list must be processed prior to building the periodic table object.  The getInfo command provides a mechanism for operating on the dataset, in this case, we take the first element of the list if the list has at least one member.

data = getInfo["IonizationEnergies",If[Length@#>0,First@#,0.]&];
object = makeSTL[data];
Export[FileNameJoin[{$HomeDirectory,"ionizationenergy-150x21mm-no-title.stl"}],object];

Full table, including f-block and a title.

data = getInfo["IonizationEnergies",If[Length@#>0,First@#,0.]&,minHeight->0., maxHeight->10., keepMissing->True,fullTable->True]/._Missing:>0.;
title = createText["Ionization Energy",1.5,0.1,position->7{2,3.5,0}];
object=makeSTL[data,blockSize->7];

Show[{object,title}]

Export[
FileNameJoin[{$HomeDirectory,"ionizationenergy-132x76mm-title.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

No base version

data = getInfo["IonizationEnergies",If[Length@#>0,First@#,0.]&,minHeight->1.,maxHeight->10.];
object=makeSTL[data,blockSize->6,includeBase->False];
Export[FileNameJoin[{$HomeDirectory,"ionizationenergy-108x36mm-no-base.stl"}],object];

Flash-card version

data = getInfo["IonizationEnergies",If[Length@#>0,First@#,0.]&,minHeight->0.3,maxHeight->10.];
object=makeSTL[data,blockSize->3,noText->True];
Export[FileNameJoin[{$HomeDirectory,"ionizationenergy-60x24mm.stl"}],object];

Advanced tables

Advanced tables demonstrate novel trends that require some level of processing in order to be visually appealing.  They also serve as a tutorial for using some of the advanced features of the Periodic Trends package.

Human abundance (displaying a log trend)

The curated dataset stores the elemental composition of humans in grams of the element per gram of body weight, and thus range from large values (~ 0.1 g/g H) to very small values (0.1 μg/g Au).  First, any missing values and elements with a reported concentration of 0 are given a very small value, then the Log of the results are taken.  Finally, the data processing allowed some of the f-block to appear; however they will be removed from this display.

data = getInfo["HumanAbundance",Log10[#/.{Missing["NotAvailable"]->10^-12.,0.->10^-12.}]&, maxHeight->10,keepMissing->True];
title = createText["Human Abundance",1.5,0.1,position->8{2,3.5,0}];
object=makeSTL[Select[data,Head@#[[2]]==Integer&]];
Export[
FileNameJoin[{$HomeDirectory,"human-abundance.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

The STL file generated in this fashion required repairing.  Other data that can be displayed using this approach include “SolarAbundance”, “CrustAbundance”, and “OceanAbundance”.

Number of stable isotopes (list manipulation)

This is one of my favorite trends.  The curated dataset provides lists of mass numbers for stable isotopes of each element.  Returning the length of these lists provides the trend.  Coincidentally, setting the minimum and maximum heights to 0 and 10 mm, respectively, and the height of the block in mm is numerically equivalent to the number of stable isotopes (don’t forget that the height of the base is 1 mm).

data = getInfo["StableIsotopes",Length@#&, maxHeight->10,minHeight->0];
title = createText["Stable Isotopes",1.5,0.1,position -> 7 {2, 3.5, 0}];
object = makeSTL[data,blockSize-> 7, baseRim->0];

Export[
FileNameJoin[{$HomeDirectory,"stable-isotopes.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

Absolute hardness (manipulating multiple data sets)

Absolute hardness was developed by Pearson (Inorg. Chem. 1988, 27, 734) and is defined as one half the difference between ionization energy and electron affinity when both units are in electron volts.  Since both ionization energy and electron affinity are provided in the curated dataset within Mathematica, it is possible to generate a periodic table depicting this trend.  It introduces a new function, cleanInfo, which can be used to clean up data that has been processed.  In this case, the raw values are obtained for both ionization energy and electron affinity.  Then, if an element appears in both datasets, convert the values to electron volts and calculate the hardness.

d1 = getInfo["IonizationEnergies",If[Length@#>0,First@#,Null]&,dontRescale->True,keepMissing->True,fullTable->True];
d2 = getInfo["ElectronAffinity",dontRescale->True,keepMissing->True,fullTable->True];
data = Cases[MapThread[ReplacePart[#1,3->(#1[[3]]-#2[[3]])/2/96.48]&,{d1,d2}],x_/;x[[3]]>0];
title = createText["Absolute Hardness",1.5,0.1,position -> 8 {2, 3.5, 0}];
object = makeSTL[cleanInfo[data,maxHeight->10]];

Export[
FileNameJoin[{$HomeDirectory,"absolute-hardness.stl"}],
DiscretizeGraphics@Show[{object,title}]
];

Electron Configurations (loading data from a spreadsheet)

It is possible to generate truly unique trends by loading data from a spreadsheet.  Using the template provided in the Supplemental Information and saving the filled-in worksheet as a CSV file, it can be used to create a periodic table.  In this case, the trend being shown is the number of electrons in the outermost shell.  A stepwise pattern throughout each block is predicted, so deviations should be readily apparent.

csvdata = Import["aufbau.csv"];
title = createText["Aufbau analysis",1.5,0.1,position -> 7 {2, 3.5, 0}];
object = makeSTL[cleanInfo[csvdata,maxHeight->10,minHeight->0],blockSize->7];

Export[
FileNameJoin[{$HomeDirectory,"aufbau.stl"}],
DiscretizeGraphics@Show[{object,title}]
];