Mathematica 337 418 372
Después de intentar implementar sin éxito usando Mathematica's LongestCommonSubsequencePositions
, recurrí a la coincidencia de patrones.
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]<>""]
La regla de coincidencia de patrones,
r={{a___,Longest[y__]},{y__,b___}}:> {{a,y},{y,b},{y},{a,y,b}}},
toma un par de palabras ordenadas (representadas como listas de caracteres) y devuelve: (1) las palabras, {a,y}
y {y,b}
seguido de (2) la subcadena común y
, que vincula el final de una palabra con el comienzo de la otra palabra, y finalmente, la palabra combinada {a,y,b}
que reemplazará las palabras de entrada. Ver Belisarius para un ejemplo relacionado: /mathematica/6144/looking-for-longest-common-substring-solution
Tres caracteres de subrayado consecutivos significan que el elemento es una secuencia de cero o más caracteres.
Reverse
se emplea más tarde para garantizar que ambas órdenes se prueben. Los pares que comparten letras enlazables se devuelven sin cambios e ignorados.
Editar :
Lo siguiente elimina de la lista las palabras que están "enterradas" (es decir, totalmente contenidas) en otra palabra (en respuesta al comentario de @ flornquake).
h=Complement[r,Cases[Join[p@r,p@Reverse@r],x_/;!StringFreeQ@@x:> x[[2]]]]
Ejemplo :
{{"D", "O", "L", "O", "R", "E"}, {"L", "O", "R", "E", "M"}} /. r
devoluciones
{{"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"}