tl;dr Can you improve upon this code, which checks to see if a word can be spelled using the element symbols from the periodic table?
I recently created a periodic table that lights up. The design relies heavily on a Raspberry Pi running Mathematica to display curated data in what I hope is a visually pleasing fashion. I mention over at the Wolfram Community forum how Mathematica has played a role in multiple aspects of the project design and implementation.
Spelling words with elements is something people apparently enjoy, so now I am trying to make Mandy spell, along the lines of the Christmas lights in Stranger Things. (If you are a fan of the show, don't get your hopes up, as the GIF generator doesn't work anymore.)
It turns out, writing code to find words that can be spelled using element symbols is not too complicated (but note, I am using v9, so ElementData is returning strings rather than Entities):
(* Wolfram - please bring ElementData up to date *)
sym = (ElementData[#, "Symbol"] & /@ Range[118]) /. {"Uut" -> "Nh",
"Uup" -> "Mc", "Uus" -> "Ts", "Uuo" -> "Og"} // ToLowerCase;
(* Check if the first 1(2) characters of string can be represented by an
element symbol *)
beginwithelement[s_String] :=
MemberQ[sym, If[StringLength[s] >= #, StringTake[s, #]]] & /@ {2, 1}
(* Remove characters from a string if they represent a valid element *)
elemcheck[w_] := With[{c = beginwithelement[ToLowerCase@w]},
If[Or @@ c,
If[First@c == True, StringDrop[w, 2], StringDrop[w, 1]],
False]]
(* Keep removing valid element symbols from string if possible,
returning list of elements or False *)
spell[w_String] :=
With[{lst =
NestWhileList[elemcheck, w, If[StringQ[#], StringLength@# > 0] &]},
If[Last@lst === "",
Reverse@
Table[StringDrop[lst[[-(i + 1)]], -StringLength[lst[[-i]]]], {i,
1, Length@lst - 1}], False]]
With these functions, it is relatively straightforward to first look for all words that start with an element and then use spell to test whether or not the word can be spelled entirely with element symbols.
words = DictionaryLookup[# ~~ ___, IgnoreCase -> True] & /@ Sort@sym;
icanspell = DeleteCases[spell /@ #, False] & /@ words;
This routine finds over 17000 words that can be spelled using elemental symbols. The longest words appear to be 18 characters long: conversationalists and hypersensitivities.
Herein lies the problem The longest (English) word that can be spelled with element symbols is nonrepresentationalisms. Now, Mathematica doesn't know this word, DictionaryLookup["nonrepresentationalisms"] == {} (* True *), but even if I try to spell it with my function, it fails: spell["nonrepresentationalisms"] (* False *). The problem, I believe, is that elemcheck is biased towards two-character symbols rather than one-character symbols. Changing this bias does change the overall number of words found (to ~ 13000) but does not allow for "No N Re P Re Se N Ta Ti O N Al I Sm S" to be found because sometimes 1-letter symbols should be preferred (P instead of Pr for the 6th character) and sometimes the two-letter character is needed (Se instead of S for the 9th character).
The question is this: How might I modify the above code to traverse multiple pathways when needed? Alternatively, is there a different approach to creating a function that determines if a string of alphabetical characters can be represented by element symbols?
