From 50ea5f62eec92289a56d4eec5d938726b6a153e4 Mon Sep 17 00:00:00 2001 From: Ivan Pribela Date: Sat, 16 Nov 2013 18:06:46 +0100 Subject: [PATCH] Dodao XDS resenje za obrnuti problem kraljica. --- 10. Obrnuti problem kraljica/XDS/QUEENS2.MOD | 320 +++++++++++++++++++ 1 file changed, 320 insertions(+) create mode 100644 10. Obrnuti problem kraljica/XDS/QUEENS2.MOD diff --git a/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD b/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD new file mode 100644 index 0000000..a1356a8 --- /dev/null +++ b/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD @@ -0,0 +1,320 @@ +MODULE Queens2; +(*upgrade za xds *) + FROM IO IMPORT + WrStr, WrLn, WrCard, RdCard, OK; + + FROM SYSTEM IMPORT + TSIZE; + + FROM Storage IMPORT + ALLOCATE, DEALLOCATE; + + IMPORT FIO; + + CONST + MaxDim = 50; + + TYPE + (*Indeks = INTEGER;*) + Interval = [1 .. MaxDim]; + DomenCene = INTEGER; (*[0 .. MaxDim * MaxDim];*) + DomenBrojaKraljica = INTEGER; (*[1 .. MaxDim * MaxDim];*) + + PPolozaj = POINTER TO SPolozaj; + SPolozaj = RECORD + Ko, Vr: INTEGER; + Cena: DomenCene; + Veza: PPolozaj; + END; + + PKraljica = POINTER TO SKraljica; + SKraljica = RECORD + Pre, Sled: PKraljica; + Kandidati: PPolozaj; + TekKo, TekVr: INTEGER; + END; + + StanjeTip = RECORD + Cena: DomenCene; + PrvaKra, TekKra: PKraljica; + END; + StatusTip = (stZauzeto, stNapadnuto, stSlobodno); + ResenjeTip = RECORD + Cena: DomenCene; + Poz: ARRAY Interval, Interval OF StatusTip; + END; + VAR + BrojKol, BrojVrs: INTEGER; + BrojKraljica: INTEGER; + + PROCEDURE Unos(); + BEGIN + REPEAT + WrLn; + WrStr('Unesite broj Kolona sahovske table (od 1 do '); + WrCard(MaxDim, 1); + WrStr(') ------- '); + BrojKol:= RdCard(); + UNTIL OK AND (1 <= BrojKol) AND (BrojKol <= MaxDim); + REPEAT + WrLn; + WrStr('Unesite broj Vrsta sahovske table (od 1 do '); + WrCard(MaxDim, 1); + WrStr(') ------- '); + BrojVrs:= RdCard(); + UNTIL OK AND (1 <= BrojVrs) AND (BrojVrs <= MaxDim); + REPEAT + WrLn; + WrStr('Unesite broj kraljica (od 1 do '); + WrCard(BrojKol * BrojVrs, 1); + WrStr(') ------- '); + BrojKraljica:= RdCard(); + UNTIL OK AND (1 <= BrojKraljica) AND (BrojKraljica <= BrojKol * BrojVrs); + END Unos; + + PROCEDURE Postavi(VAR Stanje: StanjeTip); + VAR + Temp: PPolozaj; + BEGIN + WITH Stanje DO + Temp:= TekKra^.Kandidati; + TekKra^.Kandidati:= Temp^.Veza; + TekKra^.TekKo:= Temp^.Ko; + TekKra^.TekVr:= Temp^.Vr; + Cena:= Temp^.Cena; + DISPOSE(Temp); + END; + END Postavi; + + PROCEDURE Inicijalizacija(VAR Stanje: StanjeTip; VAR Br: CARDINAL); + VAR + Tek, Pom: PKraljica; + i: DomenBrojaKraljica; + BEGIN + Br:= 0; + WITH Stanje DO + Cena:= 0; + NEW(PrvaKra); + TekKra:= PrvaKra; + Tek:= PrvaKra; + Tek^.Pre:= NIL; + FOR i:= 2 TO BrojKraljica DO + Pom:= Tek; + NEW(Tek^.Sled); + Tek:= Tek^.Sled; + Tek^.Pre:= Pom; + END; + Tek^.Sled:= NIL; + END; + END Inicijalizacija; + + PROCEDURE Ispitaj(Ko, Vr: INTEGER; Granica: PKraljica; VAR Stanje: StanjeTip; VAR Status: StatusTip); + VAR + Tek: PKraljica; + Jos: BOOLEAN; + BEGIN + WITH Stanje DO + Tek:= PrvaKra; + Jos:= Tek # Granica; + Status:= stSlobodno; + WHILE Jos DO + IF (Tek^.TekKo = Ko) AND (Tek^.TekVr = Vr) THEN + Status:= stZauzeto; + Jos:= FALSE; + ELSE + IF (Tek^.TekKo = Ko) OR (Tek^.TekVr = Vr) OR (ABS(Tek^.TekKo - Ko) = ABS(Tek^.TekVr - Vr)) THEN + Status:= stNapadnuto; + END; + IF Tek^.Sled= Granica THEN + Jos:= FALSE; + ELSE + Tek:= Tek^.Sled; + END; + END; + END; + END; + END Ispitaj; + + PROCEDURE Stampa(VAR Resenje: ResenjeTip); + CONST + ImeFajla = "Resenje.txt"; + VAR + Ko, Vr: INTEGER; + Izlaz: FIO.File; + BEGIN + IF FIO.Exists(ImeFajla) THEN + Izlaz:= FIO.Append(ImeFajla); + ELSE + Izlaz:= FIO.Create(ImeFajla); + END; + WrLn; + WrStr('-----------------------------------------------------------------'); + WrStr('---------------'); + WrLn; + FIO.WrLn(Izlaz); + WrStr('Kraljice treba staviti na sledeca polja:'); + FIO.WrStr(Izlaz, 'Kraljice treba staviti na sledeca polja:'); + WrLn; + FIO.WrLn(Izlaz); + FOR Vr:= BrojVrs TO 1 BY -1 DO + WrLn; + FIO.WrLn(Izlaz); + FOR Ko:= 1 TO BrojKol DO + CASE Resenje.Poz[Ko, Vr] OF + stZauzeto: WrStr(' Q'); + FIO.WrStr(Izlaz, ' Q'); | + stNapadnuto: WrStr(' x'); + FIO.WrStr(Izlaz, ' x'); + ELSE + WrStr(' .'); + FIO.WrStr(Izlaz, ' .'); + END; + END; + END; + WrLn; + FIO.WrLn(Izlaz); + WrLn; + FIO.WrLn(Izlaz); + WrStr('Broj slobodnih polja je: '); + FIO.WrStr(Izlaz, 'Broj slobodnih polja je: '); + WrCard(BrojKol * BrojVrs - Resenje.Cena, 1); + FIO.WrCard(Izlaz, BrojKol * BrojVrs - Resenje.Cena, 1); + FIO.Close(Izlaz); + END Stampa; + + PROCEDURE Dame(BrojKol, BrojVrs: INTEGER); + VAR + Stanje: StanjeTip; + Resenje: ResenjeTip; + MinCena: DomenCene; + Br: CARDINAL; + + PROCEDURE NadjiKandidate(VAR Stanje: StanjeTip); + + PROCEDURE NadjiCenu(k, v: INTEGER; VAR Cena: DomenCene; VAR Stanje: StanjeTip); + VAR + Ko, Vr: INTEGER; + Status: StatusTip; + BEGIN + Cena:= 0; + FOR Ko:= 1 TO BrojKol DO + FOR Vr:= 1 TO BrojVrs DO + IF (Ko # k) AND (Vr # v) AND (ABS(Ko - k) # ABS(Vr - v)) THEN + Ispitaj(Ko, Vr, Stanje.TekKra, Stanje, Status); + IF Status # stSlobodno THEN + INC(Cena); + END; + ELSE + INC(Cena); + END; + END; + END; + END NadjiCenu; + + PROCEDURE Ubaci(VAR Prvi, Novi: PPolozaj); + VAR + Tek: PPolozaj; + BEGIN + IF (Prvi = NIL) OR (Novi^.Cena < Prvi^.Cena) THEN + Novi^.Veza:= Prvi; + Prvi:= Novi; + ELSE + Tek:= Prvi; + WHILE (Tek^.Veza # NIL) AND (Tek^.Veza^.Cena < Novi^.Cena) DO + Tek:= Tek^.Veza; + END; + Novi^.Veza:= Tek^.Veza; + Tek^.Veza:= Novi; + END; + END Ubaci; + + VAR + k, v: INTEGER; + Temp, Prvi: PPolozaj; + NovaCena: DomenCene; + PocKol, PocVrs: INTEGER; + + BEGIN + Prvi:= NIL; + IF Stanje.TekKra = Stanje.PrvaKra THEN + PocKol:= 1; + ELSE + PocKol:= Stanje.TekKra^.Pre^.TekKo; + END; + FOR k:= PocKol TO BrojKol DO + IF (k = PocKol) AND (Stanje.TekKra # Stanje.PrvaKra) THEN + PocVrs:= Stanje.TekKra^.Pre^.TekVr + 1; + ELSE + PocVrs:= 1; + END; + FOR v:= PocVrs TO BrojVrs DO + NadjiCenu(k, v, NovaCena, Stanje); + IF NovaCena < MinCena THEN + NEW(Temp); + WITH Temp^ DO + Veza:= NIL; + Ko:= k; + Vr:= v; + Cena:= NovaCena; + END; + Ubaci(Prvi, Temp); + END; + END; + END; + Stanje.TekKra^.Kandidati:= Prvi; + END NadjiKandidate; + + PROCEDURE ZapamtiResenje(VAR Stanje: StanjeTip; VAR Resenje: ResenjeTip); + VAR + Ko, Vr: INTEGER; + Status: StatusTip; + BEGIN + Resenje.Cena:= Stanje.Cena; + FOR Ko:= 1 TO BrojKol DO + FOR Vr:= 1 TO BrojVrs DO + Ispitaj(Ko, Vr, NIL, Stanje, Status); + Resenje.Poz[Ko, Vr]:= Status; + END; + END; + END ZapamtiResenje; + + BEGIN + Inicijalizacija(Stanje, Br); + MinCena:= BrojKol * BrojVrs + 1; + NadjiKandidate(Stanje); + WITH Stanje DO + WHILE TekKra # NIL DO + WHILE TekKra^.Kandidati # NIL DO + IF TekKra = PrvaKra THEN + INC(Br); + WrCard(Br, 4); + END; + Postavi(Stanje); + IF TekKra^.Sled = NIL THEN + IF Cena < MinCena THEN + MinCena:= Cena; + ZapamtiResenje(Stanje, Resenje); + END; + ELSE + TekKra:= TekKra^.Sled; + NadjiKandidate(Stanje); + END; + END; + TekKra:= TekKra^.Pre; + END; + Stampa(Resenje); + END; + END Dame; + + VAR + as,df : Interval; + +BEGIN + Unos(); + WrLn; + WrStr('Sacekajte !!!'); + WrLn; + Dame(BrojKol, BrojVrs); + as := 5; + df := 6; +END Queens2. -- 2.25.1