Dobble pakli generátor

A feladat, hogy generáljunk egy pakli kártyát, ahol minden kártyán k különböző tárgy van, és tetszőleges két kártya közt pontosan 1 tárgy egyezik meg.

Teszt

Első lépésként írhatunk egy tesztet, ami ellenőrzi, hogy egy pakli teljesíti-e a feltételeket.

check([]).
check([C|Cs]) :-
    forall(select(X,C,Xs),\+member(X,Xs)),
    forall(member(X,Cs),intersection(C,X,[_])),
    check(Cs).

Szavakban leírva: minden kártyára igaz, hogy csupa különböző tárgy van rajta, és a pakliban “alatta” levő összes többi kártyával vett metszete 1 hosszú.

Első verzió

Ez alapján már meg tudtam írni egy első verziót. A különbözőségi feltételt megspórolhatjuk azzal, hogy eleve úgy generáljuk a kártyákat, hogy egy kártyán ne legyen két azonos dolog. Az alábbi programban a card felelős ezért. A tárgyakat egész számok reprezentálják, és minden kártya k szám szigorúan csökkenő sorozata.

card(_,0,[]).
card(N,K,[X|Xs]) :-
    K > 0, between(K,N,X), N1 is X-1, K1 is K-1, card(N1,K1,Xs).

dobble(0,_,_,[]).
dobble(M,N,K,[C|Cs]) :-
    M > 0, M1 is M - 1, dobble(M1,N,K,Cs),
    card(N,K,C), forall(member(X,Cs),intersection(C,X,[_])).

dobble(K,Cards) :- N is K * K - K + 1, dobble(N,N,K,Cards).

Itt n a kártyák számát jelöli, ami - kis kézi próbálkozás után - kiderült, hogy mindig k+(k-1)^2 = k^2-k+1. Ez azért érdekes, mert a Dobble pakliban (k = 8) 57 helyett csak 55, a Dobble Kids pakliban (k = 6) pedig 31 helyett csak 30 kártya van, tehát van még olyan lap, amivel kiegészíthetőek lennének!

A program működött, de nem volt elég gyors. Már k = 5 esetén is gondolkodott egy pillanatig, a k = 6-ot pedig végig sem tudtam várni.

Hatékonyabban!

Először újraírtam a programot, mindenféle optimalizálásokkal. Lényegesen gyorsabb lett, de a k = 6 esetet még mindig nagyon hosszan számolta (fél óra után lelőttem):

disjunion([],Ys,Ys).
disjunion(Xs,[],Xs).
disjunion([X|Xs],[Y|Ys],[X|Zs]) :- X > Y, disjunion(Xs,[Y|Ys],Zs).
disjunion([X|Xs],[Y|Ys],[Y|Zs]) :- X < Y, disjunion([X|Xs],Ys,Zs).

insert(K,X,Fs,[A|As],Gs,[[X|A]|As]) :-
    length(A,L), L < K, disjunion(A,Fs,Gs).
insert(K,X,Fs,[A|As],Gs,[A|Bs]) :- insert(K,X,Fs,As,Gs,Bs).

dobble(0,_,_,_,_,Cs,Cs).
dobble(M,K,X,0,_,As,Bs) :-
    M > 0, X1 is X + 1, dobble(M,K,X1,K,[X1],As,Bs).
dobble(M,K,X,I,Fs,As,Cs) :-
    M > 0, I > 0, insert(K,X,Fs,As,Gs,Bs),
    M1 is M - 1, I1 is I - 1, dobble(M1,K,X,I1,Gs,Bs,Cs).

dobble(K,Cards) :-
    N is K * K - K + 1, findall([],between(1,N,_),S),
    M is N * K, dobble(M,K,1,K,[1],S,Cards).

Irodalomkutatás

Úgy éreztem, itt az ideje, hogy kicsit utánanézzek a szakirodalomban. Azt már tudtam, hogy ez valójában a véges projektív síkokkal ill. Steiner-rendszerekkel van kapcsolatban, úgyhogy itt indultam el. Találtam is egy nagyon olvasmányos, izgalmas cikket [1], ami elmagyarázza az összefüggést a latin négyzetekkel, és bemutat néhány fontos tételt.

A legfontosabb újdonság az volt, hogy nem minden k értékre megoldható a feladat, pl. k = 7 esetén nem lehet ilyet készíteni (ezt már Euler is sejtette); a k = 11 megoldhatóságára pedig ez a cikk ad negatív eredményt.

A végkicsengés viszont sajnos az volt, hogy nem igazán tudunk jobbat csinálni, mint egy, a szimmetrikákat figyelembe véve ügyesen optimalizált backtrackinget, márpedig én valami ilyet csináltam. Persze a cikk 1991-es, de azért elég lelombozó volt, hogy a k = 11 esetnél a futási időt napokban (sőt, hónapokban!) mérte.

További kutakodás után rátaláltam egy újabb cikkre [2], ami egy speciális esetre ad hatékony módszert. Az algoritmus könnyen megvalósítható, és közvetlenül szolgáltatja a megoldást (tehát nagyon gyors). Mostantól a cikk jelöléseit követve n a projektív sík rendjét fogja jelölni, tehát n = k-1. Az algoritmus csak akkor működik, ha ez a szám prím.

mod1(M,N,L) :- L is M mod N, L > 0, !.
mod1(_,N,N).

point(_,0,0,0).
point(N,I,0,P) :- I > 0, P is (I - 1) div N.
point(N,I,J,P) :- I =< N, J > 0, P is N * I + J.
point(N,I,J,P) :-
    I > N, J > 0, T1 is (J - 1) * ((I - 1) div N - 1) + I,
    mod1(T1,N,T2), P is N * J + T2.

line(N,_,M,[]) :- M > N, !.
line(N,I,J,[P|Ps]) :- point(N,I,J,P), J1 is J + 1, line(N,I,J1,Ps).

line(N,I,L) :- M is N * (N + 1), between(0,M,I), line(N,I,0,L).

dobble(K,Cards) :- N is K - 1, findall(L,line(N,_,L),Cards).

Mivel itt nem használjuk igazán ki a Prolog lehetőségeit, egy “hagyományosabb” nyelvben (itt: Julia) kicsit könnyebben érthető programot kapunk:

function point(n, i, j)
    if i == j == 0
        0
    elseif j == 0
        (i - 1) ÷ n
    elseif i <= n
        n * i + j
    else
        n * j + mod1((j - 1) * ((i - 1) ÷ n - 1) + i, n)
    end
end

line(n, i) = [point(n, i, j) for j in 0:n]

dobble(k) = [line(k - 1, i) for i in 0:(k-1)*k]

A cikk azt is bizonyítja, hogy ha n nem prímszám, akkor mindig lesz egy rossz pár. Legyen p az n egyik prímtényezője. Ekkor line(n,n+1) és line(n,(p+1)*n+1) legalább két számban egyezik. Pl. n = 4 esetén p = 2 és

Merre tovább?

card([rabbit,shark,cat,penguin,rooster,owl]).
card([sheep,hippo,fish,shark,tiger,gorilla]).
card([dolphin,kangaroo,cat,sheep,parrot,whale]).
card([tiger,duck,snake,turtle,cat,bear]).
card([elephant,octopus,turtle,sheep,camel,owl]).
card([rabbit,sheep,cow,crocodile,horse,snake]).
card([snake,elephant,zebra,rooster,fish,parrot]).
card([frog,whale,zebra,horse,shark,turtle]).
card([shark,duck,dog,crocodile,parrot,octopus]).
card([rabbit,dolphin,hippo,camel,duck,zebra]).
card([duck,lion,sheep,rooster,ladybug,frog]).
card([duck,penguin,kangaroo,horse,gorilla,elephant]).
card([shark,dolphin,bear,ladybug,cow,elephant]).
card([dolphin,octopus,tiger,rooster,horse,crab]).
card([hippo,penguin,whale,ladybug,octopus,snake]).
card([lion,cow,cat,zebra,gorilla,octopus]).
card([tiger,whale,elephant,dog,lion,rabbit]).
card([cow,duck,crab,owl,fish,whale]).
card([ladybug,gorilla,crab,rabbit,parrot,turtle]).
card([hippo,parrot,owl,bear,lion,horse]).
card([bear,zebra,sheep,penguin,crab,dog]).
card([shark,lion,camel,crab,kangaroo,snake]).
card([hippo,kangaroo,rooster,cow,turtle,dog]).
card([hippo,cat,crocodile,frog,elephant,crab]).
card([octopus,kangaroo,frog,rabbit,bear,fish]).
card([gorilla,snake,dolphin,frog,dog,owl]).
card([cow,camel,frog,parrot,tiger,penguin]).
card([tiger,zebra,owl,kangaroo,crocodile,ladybug]).
card([dolphin,fish,turtle,lion,penguin,crocodile]).
card([camel,whale,crocodile,gorilla,rooster,bear]).

animals(As) :- setof(A,C^(card(C),member(A,C)),As).

Mellesleg ez 31 különböző állat (ahogy azt vártuk), míg a szabálykönyv 30-ról ír.

choose(_,0,[]).
choose([X|Xs],N,[X|Ys]) :- N > 0, N1 is N - 1, choose(Xs,N1,Ys).
choose([_|Xs],N,Ys) :- N > 0, choose(Xs,N,Ys).

?- animals(As), choose(As,6,X), forall(card(C),intersection(C,X,[_])).
As = [...]
X = [camel, cat, dog, fish, horse, ladybug]

Hivatkozások

[1] C.W.H. Lam: The search for a finite projective plane of order 10. The American Mathematical Monthly 98(4), pp. 305-318, 1991.