This has [quadratic, he said] actually perhaps cubic complexity in a worst case (okay, now I'm just confused. More below).. Not the fastest of the lot, but it seems reasonable, or at least not entirely unreasonable. Requires some thought for me to see what I'm doing that keeps it relatively slow.
squareFree[wrd_String] := squareFreeC[ToCharacterCode[wrd]]
notSqrFreeAtTail = Compile[{{chars, _Integer, 1}}, Module[
{j, k, n = Length[chars], nhalf},
nhalf = Floor[n/2];
For[j = 1, j <= nhalf, j++,
For[k = 0, k < j, k++,
If[chars[[n - k]] != chars[[n - j - k]], Break[]];
];
If[k == j, Return[True]];
];
False
]];
squareFreeC = Compile[{{chars, _Integer, 1}}, Module[
{j, n = Length[chars]},
For[j = 2, j <= n, j++,
If[notSqrFreeAtTail[chars[[1 ;; j]]], Return[False]];
];
True
], CompilationOptions -> {"InlineExternalDefinitions" -> True},
RuntimeOptions -> "Speed", CompilationTarget -> "C"];
Timing[squareFree[benchmark]]
(* Out[12]= {1.22, True} *)
Re complexity: If I did this correctly then the total number of character comparisons should be no more than n choose 2 with n the length of the input. Ergo quadratic complexity. With particular emphasis in that "if".
--- edit ---
This next code enumerates all square free ternary words up to length n. It explicitly maintains the word list (as lists of integers range 0-2). It also records sufficient information that one could reconstruct all smaller such words, and gives a count of the full set. I did not try for the absolute maximal compression for the method of recording new words, but I believe that can be done in such a way as to take up only a few bits per new square free word. The basic idea is, recursively, to store only the new last letter from a given word of length one less. What I do is store a value between 0 and 7 (actually 6). The binary bits that are set indicate the corresponding letters that can follow this particular word with the result still being square free.
--- edit #2 (changed code) ---
squareFreeTernaryWords[n_Integer] :=
Module[{jwds, allwds, count = 1, jwd, newjwds, jnew, newwd},
allwds = Table[{}, {n}];
allwds[[1]] = {0};
allwds[[2]] = {1};
jwds = {{0, 1}};
Do[
allwds[[j]] = ConstantArray[0, Length[jwds]];
newjwds = Reap[
Do[
jwd = jwds[[k]];
jnew = 0;
For[i = 0, i <= 2, i++,
If[i != Last[jwd],
newwd = Append[jwd, i];
If[squareFreeC[newwd],
count++;
jnew = jnew + 2^i;
Sow[newwd]];
]];
allwds[[j, k]] = jnew;
, {k, Length[jwds]}];][[2, 1]];
jwds = newjwds;
Print[{j, Length[jwds]}];,
{j, 3, n}];
{jwds, count}]
--- end edit #2 ---
I did not try to use Compile but it could be rewritten to do so. It will use whatever square-free tester you like, provided that it operates correctly when given a list of integers. It should be posible to parallelize the k loop.
--- end edit ---
--- Mike's edit ---
Parallelization
I tried boiling down your code to just get the counts in parallel (for the k loop) for my 24 core machine. Replacing the ParallelDo[] with a Do[] makes it work, not sure why it isn't working...
SetSharedVariable[jwds, newjwds, count, jwd];
DistributeDefinitions[squareFree,notSqrFreeAtTail,squareFreeC];
SetSharedVariable[newjwds, count];
count = 1;
jwds = {{0, 1}};
Do[
newjwds = {};
ParallelDo[
jwd = jwds[[k]];
For[i = 0, i <= 2, i++,
If[i == Last[jwd], Continue[], newwd = Append[jwd, i]];
If[squareFreeC[newwd], count++; AppendTo[newjwds, newwd];];
];
,{k, Length[jwds]}
];
jwds = newjwds;
Print[{j, 6*Length[jwds]}];
,{j, 3, 111}
]
--- end Mike's edit ---
--- edit #3 ---
I confess I had no joy from ParallelXXX. Everything I tried either did not work or was hugely slower than a straight serial computation.
If I jettison the tree emulation (and thus give up on recovering all words generated) then I can readily get the full body of code through Compile. I show one alternative below. It uses Leonid's square free tester because that was the fastest I saw in this thread. I do not think all the option settings are needed but kept them just in case.
With[{squareFreeQLSC = squareFreeQLSC},
squareFreeTernaryWordsC =
Compile[{{n, _Integer}},
Module[{jwds, count = 1, newjwds, jwd, newwd, children, i, m},
jwds = {{0, 1}};
Do[
newjwds = Table[
jwd = jwds[[k]];
children = ConstantArray[3, 2 j];
m = 0;
For[i = 0, i <= 2, i++,
If[i != Last[jwd],
newwd = Append[jwd, i];
If[squareFreeQLSC[newwd]==0,
(*children[[m+1;;m+j]]=newwd;m+=j*)
Do[children[[++m]] = newwd[[l]], {l, j}]];
];
];
children
, {k, Length[jwds]}];
jwds = Partition[Flatten[newjwds], j];
jwds = Select[jwds, FreeQ[#, 3] &];
count += Length[jwds];
Print[{j, count}];
,
{j, 3, n}];
count
], CompilationOptions -> {"InlineExternalDefinitions" -> True,
"InlineCompiledFunctions" -> True}, CompilationTarget -> "C",
RuntimeOptions -> "Speed"]];
This next takes up substantial memory. But it is fairly fast.
In[6]:= AbsoluteTiming[sf = squareFreeTernaryWordsC[55];]
(* During evaluation of In[6]:= {3,3}
During evaluation of In[6]:= {4,6}
During evaluation of In[6]:= {5,11}
During evaluation of In[6]:= {6,18}
During evaluation of In[6]:= {7,28}
During evaluation of In[6]:= {8,41}
During evaluation of In[6]:= {9,59}
During evaluation of In[6]:= {10,83}
During evaluation of In[6]:= {11,117}
During evaluation of In[6]:= {12,161}
During evaluation of In[6]:= {13,218}
During evaluation of In[6]:= {14,294}
During evaluation of In[6]:= {15,397}
During evaluation of In[6]:= {16,530}
During evaluation of In[6]:= {17,704}
During evaluation of In[6]:= {18,936}
During evaluation of In[6]:= {19,1241}
During evaluation of In[6]:= {20,1639}
During evaluation of In[6]:= {21,2169}
During evaluation of In[6]:= {22,2860}
During evaluation of In[6]:= {23,3763}
During evaluation of In[6]:= {24,4935}
During evaluation of In[6]:= {25,6468}
During evaluation of In[6]:= {26,8450}
During evaluation of In[6]:= {27,11031}
During evaluation of In[6]:= {28,14401}
During evaluation of In[6]:= {29,18805}
During evaluation of In[6]:= {30,24542}
During evaluation of In[6]:= {31,32019}
During evaluation of In[6]:= {32,41760}
During evaluation of In[6]:= {33,54447}
During evaluation of In[6]:= {34,70993}
During evaluation of In[6]:= {35,92579}
During evaluation of In[6]:= {36,120670}
During evaluation of In[6]:= {37,157256}
During evaluation of In[6]:= {38,204881}
During evaluation of In[6]:= {39,266915}
During evaluation of In[6]:= {40,347656}
During evaluation of In[6]:= {41,452767}
During evaluation of In[6]:= {42,589626}
During evaluation of In[6]:= {43,767878}
During evaluation of In[6]:= {44,999923}
During evaluation of In[6]:= {45,1302069}
During evaluation of In[6]:= {46,1695354}
During evaluation of In[6]:= {47,2207435}
During evaluation of In[6]:= {48,2874102}
During evaluation of In[6]:= {49,3742053}
During evaluation of In[6]:= {50,4871874}
During evaluation of In[6]:= {51,6342700}
During evaluation of In[6]:= {52,8257432}
During evaluation of In[6]:= {53,10750196}
During evaluation of In[6]:= {54,13995260}
During evaluation of In[6]:= {55,18219685}
Out[6]= {170.046529, Null} *)
--- end edit #3 ---
--- edit #4 ---
I should mention some issues which I don't have time right now to address in the code above.
(1) My square free test is far from optimal. I should have compared all neighbors, then all neighbor pairs, then triples, etc. That would be O(n^2) with n the word length. What I did, in contrast, can repeat character pair comparisons. It might be O(n^2) on average, but it can be cubic and certainly is not the best way to go even for average cases.
(2) The enumeration should use only the "tail" test, that is, only check neighbor sets that contain the new element. This increases speed substantially. Each child test is still O(n^2) worst case though.
(3) There may be ways to improve on (2). For example, if you know that the parent word never required a test of length k neighbors to go all the way to the last elements in each pair member, for all k
(4) Memory remains a serious issue. One way to address that is to pack words using FromDigits[...,3]. This would give a compression ratio of around 20. If one wants to use Compile throughout it gets slightly trickier since we'd want to use an array of machine ints rather than a bigint. If the above spped improvements are useful then maybe one need not bother so much with Compile.
--- end edit #4 ---
