Mathematica 337 418 372
Depois de tentar implementar sem sucesso usando o Mathematica LongestCommonSubsequencePositions
, virei para a correspondência de padrões.
v=Length;
p[t_]:=Subsets[t,{2}];
f[w_]:=Module[{c,x,s=Flatten,r={{a___,Longest[y__]},{y__,b___}}:>{{a,y},{y,b},{y},{a,y,b}}},
c=p@w;
x=SortBy[Cases[s[{#/.r,(Reverse@#)/.r}&/@c,1],{_,_,_,_}],v[#[[3]]]&][[-1]];
Append[Complement[w,{x[[1]],x[[2]]}],x[[4]]]]
g[r_]:=With[{h=Complement[r,Cases[Join[p@r,p@Reverse@r],y_/;!StringFreeQ@@y:>y[[2]]]]},
FixedPoint[f,Characters/@h,v@h-1]<>""]
A regra de correspondência de padrões,
r={{a___,Longest[y__]},{y__,b___}}:> {{a,y},{y,b},{y},{a,y,b}}},
pega um par ordenado de palavras (representado como lista de caracteres) e retorna: (1) as palavras {a,y}
e {y,b}
seguido por (2) a substring comum y
, que vincula o final de uma palavra ao início da outra palavra e, finalmente, a palavra combinada {a,y,b}
que substituirá as palavras de entrada. Consulte Belisarius para obter um exemplo relacionado: /mathematica/6144/looking-for-longest-common-substring-solution
Três caracteres de sublinhado consecutivos significam que o elemento é uma sequência de zero ou mais caracteres.
Reverse
é empregado posteriormente para garantir que os dois pedidos sejam testados. Os pares que compartilham letras vinculáveis são retornados inalterados e ignorados.
Editar :
O texto a seguir remove da lista as palavras "enterradas" (ou seja, totalmente contidas) em outra palavra (em resposta ao comentário de @ flornquake).
h=Complement[r,Cases[Join[p@r,p@Reverse@r],x_/;!StringFreeQ@@x:> x[[2]]]]
Exemplo :
{{"D", "O", "L", "O", "R", "E"}, {"L", "O", "R", "E", "M"}} /. r
retorna
{{"D", "O", "L", "O", "R", "E"}, {"L", "O", "R", "E", "M"}, { "L", "O", "R", "E"}, {"D", "O", "L", "O", "R", "E", "M"}}
Uso
g[{"LOREM", "ORE", "R"}]
AbsoluteTiming[g[{"AD", "DO", "DOLOR", "DOLORE", "LOREM", "MAGNA", "SED", "ORE", "R"}]]
"LOREM"
{0.006256, "SEDOLOREMAGNAD"}