Superpermutation in Prolog

Question

I want to watch 6 episodes of "friends" in all possible permutations. How can I arrange the episodes in one string so that the substrings of length 6 cover all permutations? What are the shortest such strings?

What would be the Prolog code for that?

Answer 1

Here is a brute-force implementation with an attempt to build shorter solutions first.

superpermutation(Atom, Superpermutation) :-
    bagof(Permutation, permute(Atom, Permutation), Permutations),
    select(Permutation, Permutations, RemainingPermutations),
    join(RemainingPermutations, Permutation, Superpermutation).

join([], Superpermutation, Superpermutation).
join(Permutations, Superpermutation, FinalSuperpermutation) :-
    member(OnePermutation, Permutations),
    atom_length(OnePermutation, Length), !,
    %
    between(1, Length, Position),
    select(Permutation, Permutations, RemainingPermutations),
    sub_atom(Permutation, Position, _, 0, Suffix),
    sub_atom(Superpermutation, 0, _, _, Suffix),
    sub_atom(Permutation, 0, Position, _, Prefix),
    atom_concat(Prefix, Superpermutation, NewSuperpermutation),
    join(RemainingPermutations, NewSuperpermutation, FinalSuperpermutation).

permute(Atom, PermutedAtom) :-
    atom_chars(Atom, Chars),
    permutation(Chars, PermutedChars),
    atom_chars(PermutedAtom, PermutedChars).

Here are the first solutions found for n = 2 to 7.

n = 2
212

n = 3 (length = 9)
321323123

n = 4 (length = 33)
432143241324312434213423142341234

n = 5 (length = 153)
543215432514325413254312543521435241352431524351243542135423154235142354123545
321453241532451324531245342153425134253142534125345213452314523415234512345

n = 6 (length = 873, known shorter length = 872)
654321654326154326514326541326543126543621543625143625413625431625436125436521
436524136524316524361524365124365421365423165423615423651423654123654632154632
514632541632546132546312546352146352416352461352463152463512463542163542613542
631542635142635412635462135462315462351462354162354612354653214653241653246153
246513246531246534216534261534265134265314265341265346215346251346253146253416
253461253465213465231465234165234615234651234656432156432516432561432564132564
312564352164352614352641352643152643512643562143562413562431562435162435612435
642135642315642351642356142356412356453216453261453264153264513264531264536214
536241536245136245316245361245364215364251364253164253614253641253645213645231
645236145236415236451236456321456324156324516324561324563124563421563425163425
613425631425634125634521634526134526314526341526345126345621345623145623415623
451623456123456

n = 7 (length = 5913, known shorter length = 5908) (computation time ~ 10 secs)
765432176543271654327615432765143276541327654312765437216543726154372651437265
413726543172654371265437621543762514376254137625431762543716254376125437652143
765241376524317652437165243761524376512437654213765423176542371654237615423765
142376541237654732165473261547326514732654173265471326547312654736215473625147
362541736254713625473162547361254736521473652417365247136524731652473615247365
124736542173654271365427316542736154273651427365412736547213654723165472361547
236514723654172365471236547632154763251476325417632547163254761325476312547635
214763524176352471635247613524763152476351247635421763542716354276135427631542
763514276354127635472163547261354726315472635147263541726354712635476213547623
154762351476235417623547162354761235476532147653241765324716532476153247651324
765312476534217653427165342761534276513427653142765341276534721653472615347265
134726531472653417265347126534762153476251347625314762534176253471625347612534
765213476523147652341765234716523476152347651234765743216574326157432651743265
714326574132657431265743621574362517436257143625741362574316257436125743652174
365271436527413652743165274361527436512743657214365724136572431657243615724365
172436571243657421365742316574236157423651742365714236574123657463215746325174
632571463257416325746132574631257463521746352714635274163527461352746315274635
127463572146357241635724613572463157246351724635712463574216357426135742631574
263517426357142635741263574621357462315746235174623571462357416235746123574653
217465327146532741653274615327465132746531274653721465372416537246153724651372
465317246537124653742165374261537426513742653174265371426537412653746215374625
137462531746253714625374162537461253746521374652317465237146523741652374615237
465123746573214657324165732461573246517324657132465731246573421657342615734265
173426571342657314265734126573462157346251734625713462573146257341625734612573
465217346527134652731465273416527346152734651273465721346572314657234165723461
572346517234657123465764321576432517643257164325761432576413257643125764352176
435271643527614352764135276431527643512764357216435726143572641357264315726435
172643571264357621435762413576243157624351762435716243576124357642135764231576
423517642357164235761423576412357645321764532716453276145327641532764513276453
127645372164537261453726415372645137264531726453712645376214537624153762451376
245317624537162453761245376421537642513764253176425371642537614253764125376452
137645231764523716452376145237641523764512376457321645732614573264157326451732
645713264573126457362145736241573624517362457136245731624573612457364215736425
173642571364257316425736142573641257364521736452713645273164527361452736415273
645127364572136457231645723614572364157236451723645712364576321457632415763245
176324571632457613245763124576342157634251763425716342576134257631425763412576
345217634527163452761345276314527634152763451276345721634572613457263145726341
572634517263457126345762134576231457623415762345176234571623457612345767543216
754326175432671543267514326754132675431267543621754362715436275143627541362754
316275436127543672154367251436725413672543167254361725436712543675214367524136
752431675243617524367152436751243675421367542316754236175423671542367514236754
123675463217546327154632751463275416327546132754631275463721546372514637254163
725461372546317254637125463752146375241637524613752463175246371524637512463754
216375426137542631754263715426375142637541263754621375462317546237154623751462
375416237546123754673215467325146732541673254617325467132546731254673521467352
416735246173524671352467315246735124673542167354261735426713542673154267351426
735412673546217354627135462731546273514627354162735461273546721354672315467235
146723541672354617235467123546753214675324167532461753246715324675132467531246
753421675342617534267153426751342675314267534126753462175346271534627513462753
146275341627534612753467215346725134672531467253416725346172534671253467521346
752314675234167523461752346715234675123467564321756432715643275164327561432756
413275643127564372156437251643725614372564137256431725643712564375216437526143
752641375264317526437152643751264375621437562413756243175624371562437516243756
124375642137564231756423715642375164237561423756412375647321564732516473256147
325641732564713256473125647352164735261473526417352647135264731526473512647356
214735624173562471356247315624735162473561247356421735642713564273156427351642
735614273564127356472135647231564723516472356147235641723564712356475321647532
614753264175326471532647513264753126475362147536241753624715362475136247531624
753612475364217536427153642751364275316427536142753641275364721536472513647253
164725361472536417253647125364752136475231647523614752364175236471523647512364
756321475632417563247156324751632475613247563124756342175634271563427516342756
134275631427563412756347215634725163472561347256314725634172563471256347521634
752613475263147526341752634715263475126347562134756231475623417562347156234751
623475612347567432156743251674325617432567143256741325674312567435216743526174
352671435267413526743152674351267435621743562714356274135627431562743516274356
127435672143567241356724315672435167243561724356712435674213567423156742351674
235617423567142356741235674532167453261745326714532674153267451326745312674536
217453627145362741536274513627453162745361274536721453672415367245136724531672
453617245367124536742153674251367425316742536174253671425367412536745213674523
167452361745236714523674152367451236745632174563271456327415632745163274561327
456312745637214563724156372451637245613724563172456371245637421563742516374256
137425631742563714256374125637452163745261374526317452637145263741526374512637
456213745623174562371456237415623745162374561237456732145673241567324516732456
173245671324567312456734215673425167342561734256713425673142567341256734521673
452617345267134526731452673415267345126734562173456271345627314562734156273451
627345612734567213456723145672341567234516723456172345671234567

n = 8 -> Stack overflow!

The stack overflow for n = 8 is mostly caused by the bagof predicate. Anyone can remove this error?

Answer 2

This is my attempt, which appears to have a bug, but I don't see where it is exactly. If you see it, please let me know where it is.

First, let's follow the algorithm sketched by Wikipedia for N<5:

super([X], [X], 1).
super([X|Xs], Super, N) :-
    %% obtain the superpermutation of N-1
    super(Xs, Super0, N0),
    succ(N0, N),

    %% split Super0 into its individual permutations
    split_permutations(N0, Super0, Permutations),

    %% insert X into the middle of a copy of each of these
    maplist(insert_surrounded(X), Permutations, NewPermutations),

    %% concatenate the new permutations and deduplicate them
    append(NewPermutations, SuperWithDupes),
    deduplicate(SuperWithDupes, Super).

Now to make this go, we will need quite a few utility predicates, starting with deduplication and testing whether a sublist is a permutation:

deduplicate([X], [X]).
deduplicate([X,Y|Xs], Dedup) :-
    (X == Y ->
        deduplicate([Y|Xs], Dedup)
    ;
        deduplicate([Y|Xs], Dedup1),
        Dedup = [X|Dedup1]
    ).

is_unique([]).
is_unique([X|Xs]) :-
    \+ memberchk(X, Xs),
    is_unique(Xs).

Now to obtain the permutations from the N-1 call, I have split_permutations/3 which gives you back the permutations (in order) of an earlier call to super/2:

split_permutations(_, [], []).
split_permutations(Length, [X|Xs], Permutations) :-
    split_permutations(Length, Xs, Permutations1),
    length(L, Length),
    (prefix(L, [X|Xs]), is_unique(L) ->
        Permutations = [L|Permutations1]
    ;
        Permutations = Permutations1
    ).

insert_surrounded/3 uses SWI-Prolog trick append/2:

insert_surrounded(X, Permutation, NewPermutation) :-
    append([Permutation, [X], Permutation], NewPermutation).

For my own edification, I wrote a thing to output a list slammed together so that I could compare my output to Wikipedia's:

write_string([]) :- nl.
write_string([X|Xs]) :- write(X), write_string(Xs).

For N=3, I get the same thing as Wikipedia:

?- super([3,2,1], X, Y), write_string(X).
123121321
X = [1, 2, 3, 1, 2, 1, 3, 2, 1],
Y = 3 .

I note with some dissatisfaction that using the first item in the list rather than the last is forcing me to present the input reversed. I would believe it if this was my problem with the next output, which is N=4:

• 12341232314231312431213421313241323214321 (mine)
• 123412314231243121342132413214321 (Wikipedia)

I am thinking now that it would have been better to generate some sort of superpermutation tree, and then have an output or serialization routine that handles the deduplication, and then constructing the tree leaves it in a broken-up state throughout the program until the last step. It seems inefficient and/or a good way to introduce bugs to do the concatenating and then immediately break the concatenated strings back apart. I don't think that is essential to the algorithm though. Perhaps another intrepid Prolog programmer will see a trick here!