{Petr Hruska}
{$R+}
Program Hlavolam;
Const MaxBarev = 20;
MaxKonf = 1000; { Maximalni pocet konfiguraci, ktere algoritmus
muze navstivit. }
MaxTahu = 100;
SOUBOR_VSTUP = 'vstup.txt';
SOUBOR_VYSTUP = 'vystup.txt';
Type TKonf = Record
A : String[MaxBarev];
d : Integer; { vzdalenost od startu }
End;
TTah = Array[1 .. MaxBarev] Of Byte;
Var PocBarev : Integer;
{ Seznam konfiguraci - pole se setridenymi prvky }
PocKonf : Integer;
Seznam : Array[1 .. MaxKonf] Of TKonf;
{ Fronta }
PocFron : Integer; { pocet prvku ve fronte }
PrvFron : Integer; { index prvniho prvku ve fronte }
Fronta : Array[0 .. MaxKonf - 1] Of TKonf;
{ Tahy }
PocTahu : Integer;
Tahy : Array[1 .. MaxTahu] Of TTah;
Start : TKonf;
Cil : TKonf;
{ pomocne promenne }
K, L : TKonf;
I : Integer;
{ *** Funkce pro praci s konfiguraci *** }
{ Nastavi konfiguraci podle radku nacteneho ze souboru a inicializuje
vzdalenost K.d na -1. Do parametru N ulozi pocet barev. }
Procedure NastavKonfiguraci(radek : String; Var K : TKonf; Var N : Integer);
Var I : Integer;
Begin
N := 0;
K.d := -1;
K.A := '';
For I := 1 To Length(radek) Do
If radek[I] <> ' ' Then
Begin
N := N + 1;
K.A := K.A + radek[I];
End;
End;
{ Zjisti, zda si konfigurace K1 a K2 odpovidaji, bere v uvahu znaky '?'. }
Function Match(Var K1, K2 : TKonf) : Boolean;
Var I : Integer;
Begin
I := 1;
While (I <= PocBarev) And
((K1.A[I] = K2.A[I]) Or (K1.A[I] = '?') Or (K2.A[I] = '?')) Do I := I + 1;
Match := I > PocBarev;
End;
{ *** Funkce pro praci s tahy *** }
{ Nacte radek z tahem ze souboru, pouziva PocBarev }
Procedure NactiTah(Var F : Text; Var T : TTah);
Var I : Integer;
Begin
For I := 1 To PocBarev Do Read(F, T[I]);
Readln(F);
End;
{ Aplikuje tah T na konfiguraci K a vysledek ulozi do L.
K a L musi byt ruzne promenne.
Nastavuje L.d := K.d + 1. }
Procedure ProvedTah(Var T : TTah; Var K, L : TKonf);
Var I : Integer;
Begin
L.A[0] := K.A[0]; { nastavime stejnou delku retezce }
For I := 1 To PocBarev Do L.A[T[I]] := K.A[I];
L.d := K.d + 1;
End;
{ *** Funkce pro praci se seznamem konfiguraci ***}
Procedure InitSeznam;
Begin
PocKonf := 0;
End;
{ Hleda K v seznamu konfiguraci a v pripade nalezeni vraci
jeji index v poli Seznam, jinak vraci -1.
Nepouziva hodnotu d. }
Function NajdiKonfiguraci(Var K : TKonf) : Integer;
Var l, r, m : Integer;
Begin
l := 1;
r := PocKonf;
While l <= r Do
Begin
m := (l + r) Div 2;
If Seznam[m].A < K.A Then
l := m + 1
Else If Seznam[m].A > K.A Then
r := m - 1
Else { konfigurace nalezena }
Begin
NajdiKonfiguraci := m;
Exit;
End
End;
NajdiKonfiguraci := -1;
End;
{ Vlozi konfiguraci do seznamu. Prodpoklada, ze tam konfigurace nebyla. }
Procedure VlozKonfiguraci(Var K : TKonf);
Var I : Integer;
Begin
I := PocKonf;
While (I > 0) And (K.A < Seznam[I].A) Do
Begin
Seznam[I+1] := Seznam[I];
I := I - 1;
End;
Seznam[I + 1] := K;
Inc(PocKonf);
End;
{ *** Implementace fronty *** }
Procedure InitFronta;
Begin
PrvFron := 0;
PocFron := 0;
End;
{ Prida konfiguraci do fronty }
Procedure Insert(Var K : TKonf);
Begin
Fronta[(PrvFron + PocFron) Mod MaxKonf] := K;
Inc(PocFron);
End;
{ Odebere konfiguraci z fronty. }
Procedure Extract(Var K : TKonf);
Begin
K := Fronta[PrvFron];
Dec(PocFron);
PrvFron := (PrvFron + 1) Mod MaxKonf;
End;
{ Vraci True, je-li fronta prazdna, jinak vraci False. }
Function Empty : Boolean;
Begin
Empty := PocFron = 0;
End;
{ Nacte ze souboru Start, Cil, pole Tahy,
nastavi hodnotu PocTahu a PocBarev.}
Procedure NactiVstup;
Var F : Text;
S : String;
Begin
Assign(F, SOUBOR_VSTUP);
Reset(F);
Readln(F, S);
NastavKonfiguraci(S, Start, PocBarev);
Readln(F, S);
NastavKonfiguraci(S, Cil, PocBarev);
PocTahu := 0;
While Not Eof(F) Do
Begin
PocTahu := PocTahu + 1;
NactiTah(F, Tahy[PocTahu]);
End;
Close(F);
End;
Procedure ZapisVystup(X : Integer);
Var F : Text;
Begin
Assign(F, SOUBOR_VYSTUP);
Rewrite(F);
Writeln(F, X);
Writeln(X);
Close(F);
End;
Procedure OznacVloz(Var K : TKonf);
Begin
VlozKonfiguraci(K); { oznaceni }
Insert(K);
End;
{ Hleda inverzni permutaci, K a L musi byt ruzne promenne }
Procedure Inv(Var P, Q : TTah);
Var I : Integer;
Begin
For I := 1 To PocBarev Do Q[P[I]] := I;
End;
Procedure PrintKonf(Var K : TKonf);
Var I : Integer;
Begin
For I := 1 To PocBarev Do Write(K.A[I], ' ');
Writeln(' d = ', K.d);
End;
{ Vypise cestu v opacnem poradi od konfigurace C do startu }
Procedure VypisCestu(Var C : Tkonf);
Var d, I, m : Integer;
T : TTah;
K, L : TKonf;
Begin
K := C;
For d := C.d - 1 DownTo 0 Do
Begin
PrintKonf(K);
{ Budu vzdy hledat nejakeho predchudce K, tj. souseda, ktery ma
vzdalenost d. }
For I := 1 To PocTahu Do
Begin
Inv(Tahy[I], T);
ProvedTah(T, K, L);
m := NajdiKonfiguraci(L);
If (m <> -1) And (Seznam[m].d = d) Then
Begin
L.d := K.d - 1; { ProvedTah nastavuje o 1 vetsi }
K := L;
Break;
End;
End;
End;
PrintKonf(K);
End;
{ Odpovida-li konfigurace cili, zapise vysledky a ukonci program. }
Procedure TestCil(Var K : TKonf);
Begin
If Match(K, Cil) Then
Begin
VypisCestu(K);
ZapisVystup(K.d);
Halt;
End;
End;
Begin
InitSeznam;
InitFronta;
NactiVstup;
Start.d := 0;
TestCil(Start);
OznacVloz(Start);
While Not Empty Do
Begin
Extract(K);
For I := 1 To PocTahu Do { cyklus pres vsechny sousedy }
Begin
ProvedTah(Tahy[I], K, L);
If NajdiKonfiguraci(L) = -1 Then
Begin
TestCil(L);
OznacVloz(L);
End;
End;
End;
ZapisVystup(-1); { nenalezeno }
End.