aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

33
Task/Superpermutation-minimisation/Mathematica/superpermutation-minimisation.math Normal file
View file

@ -0,0 +1,33 @@
ClearAll[OverlapDistance, ConstructDistances]
OverlapDistance[{s1_List, s2_List}] := OverlapDistance[s1, s2]
OverlapDistance[s1_List, s2_List] := Module[{overlaprange, overlap, l},
overlaprange = {Min[Length[s1], Length[s2]], 0};
l = LengthWhile[Range[Sequence @@ overlaprange, -1], Take[s1, -#] =!= Take[s2, #] &];
overlap = overlaprange[[1]] - l;
<|"Overlap" -> overlap, "Distance" -> Length[s2] - overlap|>
]
ConstructDistances[perms_List] := Module[{sel, OD, fullseq},
OD = BlockMap[OverlapDistance, perms, 2, 1];
fullseq =
Fold[Join[#1, Drop[#2[[2]], #2[[1]]["Overlap"]]] &,
First[perms], {OD, Rest[perms]} // Transpose];
fullseq
]
Dynamic[Length[perms]]
Do[
n = i;
perms = Permutations[Range[n]];
{start, perms} = TakeDrop[perms, 1];
While[Length[perms] > 0,
last = Last[start];
dists =
Table[<|"Index" -> i, OverlapDistance[last, perms[[i]]]|>, {i,
Length[perms]}];
sel = First[TakeSmallestBy[dists, #["Distance"] &, 1]];
AppendTo[start, perms[[sel["Index"]]]];
perms = Delete[perms, sel["Index"]];
];
Print[{n, Length@ConstructDistances[start]}]
,
{i, 1, 7}
]