{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.