29
$\begingroup$

I am looking into splitting words into a succession of chemical elements symbols, where possible. For example:

Titanic = Ti Ta Ni C (titanium, tantalum, nickel, carbon)

A word may or may not be decomposable under those rules, and if it is the decomposition might not be unique. I did two things: the first is a function checking if a decomposition is possible. I relied on the trivial regular expression to do so:

elements = ToLowerCase /@ Select[Table[ElementData[i, "Symbol"], {i, Length@ElementData[]}], StringLength[#] < 3 &] regexp = RegularExpression["(" <> StringJoin@Riffle[elements, "|"] <> ")+"]; decomposable[s_] := StringMatchQ[ToLowerCase@s, regexp]; decomposable /@ {"Mathematica", "archbishop"}

which gives: {False, True}.

Slightly harder was to implement a function returning possible decompositions. I recently learnt of the existence of Sow and Reap via this very website, so I implemented the most naïve, greedy algorithm with a recursive function:

beginsWith[s_, sub_] := (StringTake[s, Min[StringLength[s], StringLength[sub]]] == sub); decompose0[s_, pre_] := Module[{list, remains}, If[StringLength[s] == 0, Sow[pre]]; list = Select[elements, beginsWith[s, #] &]; remains = StringDrop[s, StringLength[#]] & /@ list; If[Length[list] >= 1, decompose0[remains[[1]], pre <> " " <> list[[1]]]]; If[Length[list] >= 2, decompose0[remains[[2]], pre <> " " <> list[[2]]]]; ]; decompose[s_] := Reap[decompose0[ToLowerCase@s, ""]][[2, 1]];

This works nicely:

In:= decompose["archbishop"] Out= {" ar c h b i s h o p", " ar c h b i s ho p", " ar c h bi s h o p", " ar c h bi s ho p"} In:= decompose["titanic"] Out= {" ti ta n i c", " ti ta ni c"}

So, the question is: in which way could I use Mathematica’s higher-level functions, e.g. the pattern-matching ones, to improve the algorithm or the code simplicity? I'm not into code-golfing, so it's not about making the code shorter, but about using a better-optimized algorithm or writing higher-level code. (The above I could pretty much have written in C, C++ or Fortran, my usual languages.)

Improve this question
$\endgroup$
3
  • $\begingroup$ This is partly a code review question, since I already have an example which works fine enough for my application, yet I am wondering how much “better” I could have written it. As far as I could guess from this meta question, I hope it will be acceptable. $\endgroup$ Commented Mar 24, 2012 at 16:44
  • 7
    $\begingroup$ I think this is a great question and I will civilly resist any efforts to close or migrate it. $\endgroup$ Commented Mar 24, 2012 at 21:08
  • $\begingroup$ (I am leaving the above comments as I think this helps set guidelines in absence of a more fleshed out FAQ.) $\endgroup$ Commented May 19, 2012 at 23:13

8 Answers 8

Reset to default
25
$\begingroup$

Here is a hybrid recursive/StringReplaceList method. It builds a tree representing all possible splits.

Now with a massive speed improvement thanks to Rojo's brilliance.

Updated element list per bobthechemist.

elements = Array[ElementData[#, "Symbol"] &, 118] /. {"Uup" -> "Mc", "Uus" -> "Ts", "Uuo" -> "Og"} // ToLowerCase; f1[""] = Sequence[]; f1[s_String] := Block[{f1}, StringReplaceList[s, StartOfString ~~ a : elements ~~ b___ ~~ EndOfString :> a ~~ f1@b ]]

Testing:

f1 @ "titanic" 
{"ti" ~~ {"ta" ~~ {"n" ~~ {"i" ~~ {"c"}}, "ni" ~~ {"c"}}}} 
f1 @ "archbishop" 
{"ar" ~~ {"c" ~~ {"h" ~~ {"b" ~~ {"i" ~~ {"s" ~~ {"h" ~~ {"o" ~~ {"p"}}, "ho" ~~ {"p"}}}}, "bi" ~~ {"s" ~~ {"h" ~~ {"o" ~~ {"p"}}, "ho" ~~ {"p"}}}}}}}

Responding to comments below and whuber's post, an extension that generates string lists:

f2[s_String] := { f1[s] } //. x_ ~~ y_ :> Thread[x ~~ "." ~~ y] // Flatten f2 @ "titanic" f2 @ "archbishop" 
{"ti.ta.n.i.c", "ti.ta.ni.c"} {"ar.c.h.b.i.s.h.o.p", "ar.c.h.b.i.s.ho.p", "ar.c.h.bi.s.h.o.p", "ar.c.h.bi.s.ho.p"}

Incidentally:

f2 @ "inconspicuousness" 
in.c.o.n.s.p.i.c.u.o.u.s.n.es.s in.c.o.n.s.p.i.c.u.o.u.s.ne.s.s in.c.o.n.s.p.i.c.u.o.u.sn.es.s in.c.o.n.s.p.i.cu.o.u.s.n.es.s in.c.o.n.s.p.i.cu.o.u.s.ne.s.s in.c.o.n.s.p.i.cu.o.u.sn.es.s in.co.n.s.p.i.c.u.o.u.s.n.es.s in.co.n.s.p.i.c.u.o.u.s.ne.s.s in.co.n.s.p.i.c.u.o.u.sn.es.s in.co.n.s.p.i.cu.o.u.s.n.es.s in.co.n.s.p.i.cu.o.u.s.ne.s.s in.co.n.s.p.i.cu.o.u.sn.es.s i.n.c.o.n.s.p.i.c.u.o.u.s.n.es.s i.n.c.o.n.s.p.i.c.u.o.u.s.ne.s.s i.n.c.o.n.s.p.i.c.u.o.u.sn.es.s i.n.c.o.n.s.p.i.cu.o.u.s.n.es.s i.n.c.o.n.s.p.i.cu.o.u.s.ne.s.s i.n.c.o.n.s.p.i.cu.o.u.sn.es.s i.n.co.n.s.p.i.c.u.o.u.s.n.es.s i.n.co.n.s.p.i.c.u.o.u.s.ne.s.s i.n.co.n.s.p.i.c.u.o.u.sn.es.s i.n.co.n.s.p.i.cu.o.u.s.n.es.s i.n.co.n.s.p.i.cu.o.u.s.ne.s.s i.n.co.n.s.p.i.cu.o.u.sn.es.s
Improve this answer
$\endgroup$
7
  • 3
    $\begingroup$ Really nice solution Mr.Wizard! @F'x: for the collapse, you can use the end of my answer: temp //. {{x_String, {y__String}} :> {x, y}} //. {x__String, y : {__List}} :> (Join[{x}, #] & /@ y), plugging Mr.Wizard's result into temp. $\endgroup$ Commented Mar 30, 2012 at 13:53
  • 1
    $\begingroup$ @F'x Another way of handling the tree would be: Replace[f1 @ "archbishop", {List[x_, y__] :> OpenerView[{x, y}], {p_} :> p}, {0, -1}] $\endgroup$ Commented Mar 30, 2012 at 19:05
  • 1
    $\begingroup$ @Mr.Wizard. I think your first answer is great now. The double replacement you wanted to avoid, can be avoided with a 40x speed increase in my tests, with your favourite trick: Block[{f1}, StringReplaceList[s, StartOfString ~~ a : altelem ~~ b___ ~~ EndOfString :> List[a, f1@b]][[All, 1]] // Flatten] $\endgroup$ Commented Mar 31, 2012 at 8:56
  • 1
    $\begingroup$ The speedup is not because of the nested list replacement. You can use the same trick to speed up your second option, wrapping Block[{f2b}, ...] until right before the //. $\endgroup$ Commented Mar 31, 2012 at 9:37
  • 1
    $\begingroup$ Would you consider updating your element list? elements = ToLowerCase[ Array[ElementData[#, "Symbol"] &, 118] /. {"Uup" -> "Mc", "Uus" -> "Ts", "Uuo" -> "Og"}] $\endgroup$ Commented May 30, 2017 at 21:42
17
$\begingroup$

Here is a fairly simple approach using only higher level functions. First, note that StringCases does almost all the work for you. István mentioned it in passing, but it is more powerful than that. It has an Overlap option that you can set to True to get all possible decompositions in one go:

elements = Table[ElementData[i, "Symbol"], {i, 112}]; StringCases["titanic", elements, Overlaps -> True, IgnoreCase -> True] Out[1]= {"ti", "i", "ta", "n", "ni", "i", "c"} StringCases["archbishop", elements, Overlaps -> True, IgnoreCase -> True] Out[2]= {"ar", "c", "h", "b", "bi", "i", "s", "h", "ho", "o", "p"}

That's a pretty clean way of getting them all! I used IgnoreCase instead of ToLowerCase in elements, but either way is fine.

Next, you just need to find the subsets of the decomposition that give you back the original string. Since we're dealing with symbols of max length 2, your subsets only need to be restricted to $\displaystyle\lceil\frac{\text{string length}}{2}\rceil$ to $\text{string length}$:

Select[Subsets[{"ti", "i", "ta", "n", "ni", "i", "c"}, {4, 7}], StringJoin[#] == "titanic" &] Out[3]= {{"ti", "ta", "ni", "c"}, {"ti", "ta", "n", "i", "c"}} Select[Subsets[{"ar", "c", "h", "b", "bi", "i", "s", "h", "ho", "o", "p"}, {5, 10}], StringJoin[#] == "archbishop" &] Out[4]= {{"ar", "c", "h", "bi", "s", "ho", "p"}, {"ar", "c", "h", "b", "i", "s", "ho", "p"}, {"ar", "c", "h", "bi", "s", "h", "o", "p"}, {"ar", "c", "h", "b", "i", "s", "h", "o", "p"}}

You can now bundle this up neatly as follows:

Begin["FXWords`"]; elements = Table[ElementData[i, "Symbol"], {i, 112}]; ElementDecompose[word_String] := Module[{decomps}, decomps = StringCases[word, elements, Overlaps -> True, IgnoreCase -> True]; Select[Subsets[decomps, {Ceiling[#/2], #}], StringJoin[#] == word &] &@StringLength[word] ]; End[];

and call it as FXWords`ElementDecompose["titanic"]

Improve this answer
$\endgroup$
4
  • $\begingroup$ Nice. Good explanation too. One thing: by splitting into all possible decompositions you needlessly increase the number of subsets. MMA will try combinations that never could form the word. like "b"and "bi", and "bi" and "i". $\endgroup$ Commented Mar 30, 2012 at 18:31
  • $\begingroup$ @SjoerdC.deVries The OP wanted all possible decompositions. I'm aware that the subsets grow large with increasing word length. Also, as the word gets longer, the chances of it being decomposable into chemical elements goes down drastically (I don't know the odds, but it's an empirical observation). $\endgroup$ Commented Mar 30, 2012 at 19:20
  • $\begingroup$ Actually, I think I made an conceptual error here (end of the week etc.). Let's just forget it. $\endgroup$ Commented Mar 30, 2012 at 19:38
  • 3
    $\begingroup$ @All: While the above is simple and intuitive, it is also wasteful. For example, in the case of "inconspicuousness", I generate about 3.5million subsets when I need only 24 of those. Even then, this generates 40 which contains duplicates due to the double s at the end (of course, a trivial fix with DeleteDuplicates). I'd appreciate pointers on improving this part of the code — either generating subsets in a smarter way or another approach to pair up. $\endgroup$ Commented Mar 31, 2012 at 16:52
14
$\begingroup$

Some really simple partial answers using the string patternmatcher:

elements = ToLowerCase /@ Select[Table[ElementData[i, "Symbol"], {i, Length@ElementData[]}], StringLength[#] < 3 &]; StringReplace["archbishop", # -> {#} & /@ elements] /. StringExpression -> Join StringReplace["titanic", # -> {#} & /@ elements] /. StringExpression -> Join

{"ar", "c", "h", "b", "i", "s", "h", "o", "p"}

{"ti", "ta", "n", "i", "c"}

Even more simple is StringCases:

StringCases["archbishop", Alternatives @@ elements]

{"ar", "c", "h", "b", "i", "s", "h", "o", "p"}

And a more general solution for finding all decompositions:

updated to return correct decompositions

split[word_String] := Module[{list, findPath, temp}, (* Generate an exhaustive list of positions of all possible elements in the input *) list = Sort@Flatten@DeleteCases[ Table[i -> #, {i, StringPosition[word, #]}] & /@ elements, {}]; (* recursive function to find all possible neighbouring elements in the string starting from position pos *) findPath[pos_, rest_] := If[pos == StringLength@word, Last /@ Cases[rest, _?(First@First@# == pos &)], Module[{newPos, newRest}, newRest = Cases[rest, _?(First@First@# == pos &)]; If[newRest === {}, {}, {Last@#, findPath[newPos = Last@First@# + 1, Cases[rest, _?(First@First@# >= newPos &)]]} & /@ newRest ]]]; (* call the auxiliary function and tidy up results *) temp = findPath[1, list]; If[temp === {}, {}, temp //. {{x_} :> x, {} -> Sequence[], {x_String, {y__String}} :> {x, y}} //. {x__String, y : {__List}} :> (Join[{x}, #] & /@ y)] ]; words = {"titanic", "silicon", "archbishop", "wombat"}; split /@ words // Column 
{{"ti", "ta", "n", "i", "c"}, {"ti", "ta", "ni", "c"}} {{{"s", "i", "li", "c", "o", "n"}, {"s", "i", "li", "co", "n"}}, {{"si", "li", "c", "o", "n"}, {"si", "li", "co", "n"}}} {{{"ar", "c", "h", "b", "i", "s", "h", "o", "p"}, {"ar", "c", "h", "b", "i", "s", "ho", "p"}}, {{"ar", "c", "h", "bi", "s", "h", "o", "p"}, {"ar", "c", "h", "bi", "s", "ho", "p"}}} {"w", "o"}

It now correctly gets all the valid decompositions, and returns partial decompositions for words that cannot be decomposed to elements.

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thanks István for this answer. I'm not sure it's using higher level constructs than my original code, and it sure is longer. But it's nice to see a different approach… $\endgroup$ Commented Mar 28, 2012 at 13:59
  • $\begingroup$ @F'x, yes, yours is pretty much the simplest and most efficient so far I think. $\endgroup$ Commented Mar 28, 2012 at 14:01
10
$\begingroup$

You can implement list functionality with string operations, so it's straightforward to make the output of Mr.Wizard's elegant solution more readable while retaining the focus on string operations. Let's begin with a modified version of his solution (altelem is the same as before):

f1[""] = ","; f1[s_String] := StringJoin[ StringReplaceList[s, StartOfString ~~ a : altelem ~~ b___ ~~ EndOfString :> assemble[a, f1@b]]];

Here's the crucial detail:

assemble[a_String, b_String] := StringReplace[b, "," -> "," ~~ a ~~ "."]; decompose[s_String] := StringSplit[f1[s], ","]

assemble uses a comma to initiate and separate elements of a list of strings, which is represented as a single string. Its task is to prefix its first argument a to each element of its second argument b (thought of as a "list"). This is simply accomplished by StringReplace. (I have asked it to use "." in place of spaces to make it clear exactly what happens: this character serves as a lexeme terminator, not a separator.) decompose converts this string-qua-list representation back into a List.

E.g.,

decompose["titanic"] {"ti.ta.n.i.c.", "ti.ta.ni.c."} decompose["archbishop"] {"ar.c.h.b.i.s.h.o.p.", "ar.c.h.b.i.s.ho.p.", "ar.c.h.bi.s.h.o.p.", "ar.c.h.bi.s.ho.p."} decompose["breaking"] {}

Of course, the input should not contain any commas. (If it does, change the comma in assemble and decompose to a character that does not appear.)

Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ As a former Fortran and C developer, I believe this solution doesn't remotely resemble what one would naturally code in either of those languages! The trick of using string operations to implement abstract data structures dates to a couple of mis-spent years developing in dBase. $\endgroup$ Commented Mar 30, 2012 at 22:22
  • $\begingroup$ PS: If you like this reply, please vote up the one by Mr.Wizard: to satisfy the request by @F'x, I'm really just making a minor change to what he already accomplished. $\endgroup$ Commented Mar 30, 2012 at 22:39
  • $\begingroup$ This is a nice addition, one I wish I had had time to make myself this morning. +1 $\endgroup$ Commented Mar 30, 2012 at 23:23
8
$\begingroup$

Here's a version that uses plain (not string) pattern matching and rule replacement, as well as recursion, to generate all decompositions.

EDIT to add: This approach turns out to be suprisingly efficient. I made no attempt to optimize my solution, and it doesn't make use of the string-handling functions at all, and it's about half as fast as Mr.Wizard's solution, at least on the word "inconspicuous". I've also updated the function to output the results not as lists, but as strings with "." separating the pieces, as with most other solutions.

I automatically generate the rules I need from the element symbols. I can't just use Characters to break up the string, because it's difficult to pattern match on List structures efficiently, and you can efficiently build linked lists recursively, so I convert everything into a linked list, and then extract my answers at the end:

(* Custom head for linked list nodes; it needs to be HoldAllComplete for arcane performance reasons *) Attributes[cons] = HoldAllComplete; stringToLinkedList[s_String] := Fold[cons[#2, #1] &, cons[], Reverse@Characters@s]; linkedListToList[ll_cons] := List @@ Flatten[ll] recurse[cons[]] := {cons[]}; recurse[ll_cons] := Flatten[ ReplaceList[ll, elementRules] /. {s_String, more_cons} :> With[{tails = recurse[more]}, cons[s, #] & /@ tails]]; (* Now we can use the pattern matcher to efficiently match heads and tails of the linked list, just like in a more conventional functional language like Haskell. *) elementRules = Map[ With[{chars = Characters@#}, chars /. { {c_} :> (cons[c, more_cons] :> {c, more}), {c1_, c2_} :> (cons[c1, cons[c2, more_cons]] :> {#, more})}] &, elements]; decompose[s_String] := linkedListToList /@ recurse[stringToLinkedList@ToLowerCase@s]

And now it works:

In[69]:= decompose["archbishop"] Out[69]= {{"ar", "c", "h", "b", "i", "s", "h", "o", "p"}, {"ar", "c", "h", "b", "i", "s", "ho", "p"}, {"ar", "c", "h", "bi", "s", "h", "o", "p"}, {"ar", "c", "h", "bi", "s", "ho", "p"}} In[70]:= decompose["Mathematica"] Out[70]= {}
Improve this answer
$\endgroup$
8
+100
$\begingroup$

Update #2

Now significantly cleaner and more efficient.

This uses a maximum pattern length of 20 which should be sufficient for any English word.

elements = ToLowerCase @ Array[ElementData[#, "Symbol"] &, 112]; AppendTo[elements, EndOfString]; pat = StartOfString ~~ ## -> {##}[[All, 1]] & @@ Table[Module[{x}, x : elements], {20}]; StringReplaceList["archbishop", pat][[All, 1]] /. "" -> Sequence[] 
{{"ar", "c", "h", "bi", "s", "ho", "p"}, {"ar", "c", "h", "b", "i", "s", "ho", "p"}, {"ar", "c", "h", "bi", "s", "h", "o", "p"}, {"ar", "c", "h", "b", "i", "s", "h", "o", "p"}}

You can also process a list of words in one pass like this:

words = {"sarcophagus", "arboreal", "omnipotence", "nonrepresentational"} StringReplaceList[words, pat][[All, All, 1]] /. "" -> Sequence[] // Column 
{{s,ar,c,o,p,h,ag,u,s}, {s,ar,co,p,h,ag,u,s}} {{ar,b,o,re,al}} {{o,mn,i,p,o,te,n,ce}, {o,mn,i,po,te,n,ce}} {{n,o,n,re,p,re,se,n,ta,ti,o,n,al}, {no,n,re,p,re,se,n,ta,ti,o,n,al}}

(quote marks omitted for space)

It is competitively fast:

words = DictionaryLookup[]; StringReplaceList[words, pat][[All, All, 1]] /. "" -> Sequence[]; // AbsoluteTiming 
{1.3760787, Null}
Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ This is interesting. It successfully finds the different decompositions, but TraceXxx does not verbose about how it was achieved. I am flummoxed. $\endgroup$ Commented Mar 25, 2012 at 0:03
  • $\begingroup$ Maybe it works like the Overlaps option: StringPosition["archbishop", altelem, Overlaps -> All]. $\endgroup$ Commented Mar 25, 2012 at 3:53
  • $\begingroup$ I’m awarding the bounty to this answer because, though both your answers are brilliant, I have a certain fondness for this one. $\endgroup$ Commented Apr 4, 2012 at 16:14
4
$\begingroup$ 
elements = {"ac", "ag", "al", "am", "ar", "as", "at", "au", "b", "ba", "be", "bh", "bi", "bk", "br", "c", "ca", "cd", "ce", "cf", "cl", "cm", "cn", "co", "cr", "cs", "cu", "db", "ds", "dy", "er", "es", "eu", "f", "fe", "fm", "fr", "ga", "gd", "ge", "h", "he", "hf", "hg", "ho", "hs", "i", "in", "ir", "k", "kr", "la", "li", "lr", "lu", "md", "mg", "mn", "mo", "mt", "n", "na", "nb", "nd", "ne", "ni", "no", "np", "o", "os", "p", "pa", "pb", "pd", "pm", "po", "pr", "pt", "pu", "ra", "rb", "re", "rf", "rg", "rh", "rn", "ru", "s", "sb", "sc", "se", "sg", "si", "sm", "sn", "sr", "ta", "tb", "tc", "te", "th", "ti", "tl", "tm", "u", "v", "w", "xe", "y", "yb", "zn", "zr"} set[x_] := Module[{str1, str2, i}, i = 1; str1 = Characters[x]; str2 = StringJoin[#] & /@ Partition[str1, 2, 1]; Append[Flatten[{str1[[i++]], #} & /@ str2], str1[[-1]]] ]

My InterSection:

 interSection[teststring_, dataset_] := Module[{originalstring, intersect, tmp}, originalstring = set[teststring]; intersect = Intersection[originalstring, dataset]; tmp = If[MemberQ[intersect, #], #, (## &[])] & /@ originalstring; StringJoin[StringJoin[(# <> " ") & /@ tmp], " "] ]

Analyse sentence:

 sentenceToElements[sentence_, dataset_] := Module[{words}, words = ReadList[StringToStream[sentence], Word]; StringJoin[interSection[#, elements] & /@ words] ]

usage:

sentenceToElements["this is an example of the bischop showing of his \ sumo wrestling skills", elements]

Output:

"th h i s i s n am p o f th h he b bi i s sc c h ho \ o p s h ho o w i in n o f h i s s u mo o w re es s tl \ li i in n s k i s "
Improve this answer
$\endgroup$
7
  • $\begingroup$ Well, it’s not done yet, you they’re not ordered :) $\endgroup$ Commented Mar 30, 2012 at 13:23
  • $\begingroup$ oh.. Is that important..? $\endgroup$ Commented Mar 30, 2012 at 14:00
  • $\begingroup$ yeah, that's the crux of the problem… having a list of substrings is not the funniest part of the game :) $\endgroup$ Commented Mar 30, 2012 at 14:06
  • $\begingroup$ @F'x And now? The words are back in their original order! $\endgroup$ Commented Mar 30, 2012 at 15:06
  • $\begingroup$ @F'x I edited again. Forgot the last character in the word in the set function $\endgroup$ Commented Mar 30, 2012 at 15:12
1
$\begingroup$

I think this answer provides an elegant solution -- at least for the less critical readers.

Note that the grammar generation code is the most complicated part. The rest is fairly direct and straightforward.

This generates an EBNF grammar for sequences of chemical elements:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/FunctionalParsers.m"] elemNames = ToLowerCase[ Sort[ElementData[#, "Abbreviation"] & /@ ElementData["*"]]]; ebnfChemElem = "<chem-elem> = " <> StringReplace[ ToString[ If[StringLength[#] == 1, "'" <> # <> "'", StringJoin @@ Riffle["'" <> # <> "'" & /@ Characters[#], ","]] & /@ elemNames], {", " -> " | ", "{" -> "", "}" -> ""}] <> ";"; ebnfChemSplit = "<chem-split> = { <chem-elem> } ;"; ebnfChemElem <> "\n" <> ebnfChemSplit

enter image description here

The rule for the <chem-split> specifies that <chem-split> is a list of <chem-elem> strings.

The following code generates parsers and adds parser modifiers to concatenate the characters:

res = GenerateParsersFromEBNF[ ParseToEBNFTokens[ebnfChemElem <> ebnfChemSplit]]; LeafCount[res] (* 4646 *) SetParserModifier[pCHEMELEM, StringJoin[Flatten[{#}]] &]; SetParserModifier[pCHEMSPLIT, Map[StringJoin, #] &];

The following parsing examples are with the generated pCHEMSPLIT:

words = {"titanic", "silicon", "archbishop", "wombat", "mathematica"}; ParsingTestTable[pCHEMSPLIT, words, "TokenizerFunction" -> Characters]

enter image description here

The above does not parse all possible cases because ParseMany is implemented to pick shortest parsing paths. The parser generator uses ParseMany for { ... } parts in the EBNF rules.

With an alternative, greedier ParseMany implementation we can get all possible valid parsings:

pChemElem = ParseModify[DeleteDuplicates, ParseApply[Flatten,ParseManyByBranching[pCHEMELEM]]]; words = {"titanic", "silicon", "archbishop", "wombat", "mathematica"}; ParsingTestTable[pChemElem, words, "TokenizerFunction" -> Characters]

enter image description here

(Initially I did not think that posting this answer would contribute to the discussion, but then it occurred to me that it is a continuation of another discussion with Mr.Wizard over programming styles.)

Improve this answer
$\endgroup$
2
  • $\begingroup$ I note a (tiny) issue with the last few outputs: the element boron has the symbol "B", and yet for some reason it does not get included in the valid symbols. $\endgroup$ Commented Aug 18, 2017 at 12:34
  • $\begingroup$ @J.M. I have to investigate... And thanks for looking into this answer! I mostly did in relation to my investigations of WL monadic programming and, to some extend, as a possible example for my answer of "Granular versus terse coding". $\endgroup$ Commented Aug 18, 2017 at 13:12

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.