Mathematica 337 418 372
Après avoir essayé sans succès d'implémenter à l'aide de Mathematica LongestCommonSubsequencePositions
, je me suis tourné vers la correspondance de modèles.
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 règle de correspondance de motifs,
r={{a___,Longest[y__]},{y__,b___}}:> {{a,y},{y,b},{y},{a,y,b}}},
prend une paire ordonnée de mots (représentés sous forme de listes de caractères) et renvoie: (1) les mots, {a,y}
et {y,b}
suivi par (2) la sous - chaîne commune, y
qui relie l'extrémité d'un mot avec le début de l'autre mot, et, enfin, le mot combiné {a,y,b}
qui remplacera les mots d'entrée. Voir Belisarius pour un exemple connexe: /mathematica/6144/looking-for-longest-common-substring-solution
Trois caractères de soulignement consécutifs signifient que l'élément est une séquence de zéro ou plusieurs caractères.
Reverse
est utilisé plus tard pour garantir que les deux commandes sont testées. Les paires qui partagent des lettres pouvant être liées sont retournées inchangées et ignorées.
Modifier :
Ce qui suit supprime de la liste les mots qui sont "enterrés" (c'est-à-dire entièrement contenus) dans un autre mot (en réponse au commentaire de @ flornquake).
h=Complement[r,Cases[Join[p@r,p@Reverse@r],x_/;!StringFreeQ@@x:> x[[2]]]]
Exemple :
{{"D", "O", "L", "O", "R", "E"}, {"L", "O", "R", "E", "M"}} /. r
résultats
{{"D", "O", "L", "O", "R", "E"}, {"L", "O", "R", "E", "M"}, { "L", "O", "R", "E"}, {"D", "O", "L", "O", "R", "E", "M"}}
Usage
g[{"LOREM", "ORE", "R"}]
AbsoluteTiming[g[{"AD", "DO", "DOLOR", "DOLORE", "LOREM", "MAGNA", "SED", "ORE", "R"}]]
"LOREM"
{0,006256, "SEDOLOREMAGNAD"}