9
$\begingroup$

This question already has an answer here:

What is the best approach to a problem like this in Mathematica?

I can only manage this:

 func[stringlist_] := 
   With[{i = 
   Last@Flatten@
   Table[DictionaryLookup[StringTake[#[[2]], n]], {n, 14}]}, {i,
   StringDrop[#[[2]], StringLength@i]}] &@stringlist;
func1[string_] := 
   Rest@NestWhileList[func, {"", # <> CharacterRange["a", "z"]}, 
   Length@Characters@#[[2]] > 26 &][[All, 1]] &@string;


 func1["tableapplechairtablecupboard"]

(*
{"table", "apple", "chair", "table", "cupboard"}
*)

with its obvious shortcomings.

Added

Here is a pre-made file (made from WordFrequencyData /@ DictionaryLookup[] - very slow!!) incase anyone wanted to make a weighted function:

wfd = ToExpression@
Import["https://raw.githubusercontent.com/martinq321/dictionary/master/values", "List"];

eg something like this (based on @kirma's answer below) can be used to faithfully recreate about 50% of test cases:

suggested@StringJoin@removespaces@   
TextSentences[WikipediaData["PageID" -> "5094570", "ArticlePlaintext"]][[1]]

(*
the great wall of china is a series of fortifications made of stone 
brick tamped earth wood and other materials generally built along an 
east to west line across the historical northern borders of china to 
protect the chinese states and empires against the raids and 
invasions of the various nomadic groups of the eurasian steppe
*)

though I am sure there are far quicker and more efficient methods.

$\endgroup$

marked as duplicate by Sjoerd C. de Vries, MarcoB, user9660, Community Jul 19 '16 at 15:06

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • 3
    $\begingroup$ Why wouldn't the result be {"table", "apple", "chair", "table", "cup", "board"}? $\endgroup$ – J. M. will be back soon Jul 3 '16 at 2:40
  • 3
    $\begingroup$ Proposed duplicate: (3443) $\endgroup$ – Mr.Wizard Jul 5 '16 at 6:45
  • $\begingroup$ @Mr.Wizard It looks like a duplicate though the length of the replacement list here may require methods that have a different computational complexity. Have you tested your answer to check it behaves reasonably for dictionary words? $\endgroup$ – Sjoerd C. de Vries Jul 19 '16 at 2:10
  • 1
    $\begingroup$ @Sjoerd defining altelem = Alternatives @@ DictionaryLookup[]; and using my f2 @ "tableapplecharitablecupboarding" appears faster than kirma's Module. (With Alternatives @@ DictionaryLookup[] moved outside the latter of course.) $\endgroup$ – Mr.Wizard Jul 19 '16 at 11:19
  • $\begingroup$ @Mr.Wizard in that case I'll vote to close as duplicate. $\endgroup$ – Sjoerd C. de Vries Jul 19 '16 at 12:58
13
$\begingroup$

Simple greedy matching can be done as follows: construct a string pattern with longest words first and find words:

StringCases["tableapplechairtablecupboard", 
 Alternatives @@ SortBy[DictionaryLookup[], Minus@*StringLength]]

(* {"table", "apple", "chair", "table", "cupboard"} *)

Intuitive assumption is that one might use Longest to find longest match every time, but it doesn't really seem to work in this case. Note that this variation may end up not matching the whole string as it always chooses the longest match without considering if the rest can match anything in the dictionary.

For all matches one can, for instance, find all word matches using StringPosition and then find all non-overlapping complete covers of the string using per-string-position Boolean logic and SatisfiabilityInstances:

Module[{string, positions},
  string = "tableapplecharitablecupboarding";
  positions = 
   StringPosition[string, Alternatives @@ DictionaryLookup[], 
    Overlaps -> All];
  StringTake[string, Pick[positions, #]] & /@ 
   SatisfiabilityInstances[
    And @@ (BooleanCountingFunction[{1}, Length@positions] @@@ 
       Transpose@
        MapIndexed[Function[{list, index}, # && c @@ index & /@ list],
          Table[#1 <= i <= #2, {i, StringLength@string}] & @@@ 
          positions]), Array[c, Length@positions], All]] // TableForm

$$ \begin{array}{cccccccc} \text{table} & \text{apple} & \text{char} & \text{it} & \text{able} & \text{cup} & \text{boar} & \text{ding} \\ \text{table} & \text{apple} & \text{char} & \text{it} & \text{able} & \text{cup} & \text{boarding} & \text{} \\ \text{table} & \text{apple} & \text{charitable} & \text{cup} & \text{boar} & \text{ding} & \text{} & \text{} \\ \text{table} & \text{apple} & \text{charitable} & \text{cup} & \text{boarding} & \text{} & \text{} & \text{} \\ \end{array} $$

Note that although StringPosition does find "cupboard" as a valid word substring, none of solutions contain it as remaining part of the string can't be split into set of word matches. Thus, "boar", "ding" and "boarding" are only valid endings for a match.

String matching functions do take an additional IgnoreCase -> True option, which allows for matching "I" on the above example. Sadly this option also exposes various capitalized non-words, such as "Le", whatever that might be. This problem can occur also with other naturally capitalized words, such as country names.

More procedural approaches to solution search are definitely possible, but in the lines of letting Mma avoid me constructing error-prone explicit algorithms, I've chosen the above approach which converts search to a satisfiability problem.

BTW: can anyone tell why WordList[] lacks such words as "is" and "or"? This is the reason for using DictionaryLookup[] instead.

$\endgroup$
  • 1
    $\begingroup$ many thanks - great answer :) $\endgroup$ – martin Jul 4 '16 at 17:34
  • 1
    $\begingroup$ Bounty added for your handling the more complicated problem through methods I do not recall seeing. $\endgroup$ – Mr.Wizard Jul 5 '16 at 6:47
  • 1
    $\begingroup$ IncludeInflections -> True will include "is" but "or" $\endgroup$ – yode Jul 5 '16 at 18:30
  • 1
    $\begingroup$ "is" and "or" is "Stopwords" in Mathematica you should specify the type be "Stopwords".It will include those. $\endgroup$ – yode Jul 5 '16 at 18:36
  • 1
    $\begingroup$ words=Catenate[WordList[#,Language->"English",IncludeInflections->True]&/@{"KnownWords","Stopwords"}]; will include all words.And if you run MemberQ[words, "and"],it will give True. $\endgroup$ – yode Jul 5 '16 at 20:05

Not the answer you're looking for? Browse other questions tagged or ask your own question.