gitweb on Svarog
projekti pod git sistemom za održavanje verzija -- projects under the git version control system
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 8a74ce2)
raw | patch | inline | side by side (parent: 8a74ce2)
author | Ivan Pribela <ivanpribela@gmail.com> | |
Sat, 16 Nov 2013 17:06:46 +0000 (18:06 +0100) | ||
committer | Ivan Pribela <ivanpribela@gmail.com> | |
Sat, 16 Nov 2013 17:06:46 +0000 (18:06 +0100) |
10. Obrnuti problem kraljica/XDS/QUEENS2.MOD | [new file with mode: 0644] | patch | blob |
diff --git a/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD b/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD
--- /dev/null
@@ -0,0 +1,320 @@
+MODULE Queens2;\r
+(*upgrade za xds *)\r
+ FROM IO IMPORT\r
+ WrStr, WrLn, WrCard, RdCard, OK;\r
+\r
+ FROM SYSTEM IMPORT\r
+ TSIZE;\r
+\r
+ FROM Storage IMPORT\r
+ ALLOCATE, DEALLOCATE;\r
+\r
+ IMPORT FIO;\r
+\r
+ CONST\r
+ MaxDim = 50;\r
+\r
+ TYPE\r
+ (*Indeks = INTEGER;*)\r
+ Interval = [1 .. MaxDim];\r
+ DomenCene = INTEGER; (*[0 .. MaxDim * MaxDim];*)\r
+ DomenBrojaKraljica = INTEGER; (*[1 .. MaxDim * MaxDim];*)\r
+\r
+ PPolozaj = POINTER TO SPolozaj;\r
+ SPolozaj = RECORD\r
+ Ko, Vr: INTEGER;\r
+ Cena: DomenCene;\r
+ Veza: PPolozaj;\r
+ END;\r
+\r
+ PKraljica = POINTER TO SKraljica;\r
+ SKraljica = RECORD\r
+ Pre, Sled: PKraljica;\r
+ Kandidati: PPolozaj;\r
+ TekKo, TekVr: INTEGER;\r
+ END;\r
+\r
+ StanjeTip = RECORD\r
+ Cena: DomenCene;\r
+ PrvaKra, TekKra: PKraljica;\r
+ END;\r
+ StatusTip = (stZauzeto, stNapadnuto, stSlobodno);\r
+ ResenjeTip = RECORD\r
+ Cena: DomenCene;\r
+ Poz: ARRAY Interval, Interval OF StatusTip;\r
+ END;\r
+ VAR\r
+ BrojKol, BrojVrs: INTEGER;\r
+ BrojKraljica: INTEGER;\r
+\r
+ PROCEDURE Unos();\r
+ BEGIN\r
+ REPEAT\r
+ WrLn;\r
+ WrStr('Unesite broj Kolona sahovske table (od 1 do ');\r
+ WrCard(MaxDim, 1);\r
+ WrStr(') ------- ');\r
+ BrojKol:= RdCard();\r
+ UNTIL OK AND (1 <= BrojKol) AND (BrojKol <= MaxDim);\r
+ REPEAT\r
+ WrLn;\r
+ WrStr('Unesite broj Vrsta sahovske table (od 1 do ');\r
+ WrCard(MaxDim, 1);\r
+ WrStr(') ------- ');\r
+ BrojVrs:= RdCard();\r
+ UNTIL OK AND (1 <= BrojVrs) AND (BrojVrs <= MaxDim);\r
+ REPEAT\r
+ WrLn;\r
+ WrStr('Unesite broj kraljica (od 1 do ');\r
+ WrCard(BrojKol * BrojVrs, 1);\r
+ WrStr(') ------- ');\r
+ BrojKraljica:= RdCard();\r
+ UNTIL OK AND (1 <= BrojKraljica) AND (BrojKraljica <= BrojKol * BrojVrs);\r
+ END Unos;\r
+\r
+ PROCEDURE Postavi(VAR Stanje: StanjeTip);\r
+ VAR\r
+ Temp: PPolozaj;\r
+ BEGIN\r
+ WITH Stanje DO\r
+ Temp:= TekKra^.Kandidati;\r
+ TekKra^.Kandidati:= Temp^.Veza;\r
+ TekKra^.TekKo:= Temp^.Ko;\r
+ TekKra^.TekVr:= Temp^.Vr;\r
+ Cena:= Temp^.Cena;\r
+ DISPOSE(Temp);\r
+ END;\r
+ END Postavi;\r
+\r
+ PROCEDURE Inicijalizacija(VAR Stanje: StanjeTip; VAR Br: CARDINAL);\r
+ VAR\r
+ Tek, Pom: PKraljica;\r
+ i: DomenBrojaKraljica;\r
+ BEGIN\r
+ Br:= 0;\r
+ WITH Stanje DO\r
+ Cena:= 0;\r
+ NEW(PrvaKra);\r
+ TekKra:= PrvaKra;\r
+ Tek:= PrvaKra;\r
+ Tek^.Pre:= NIL;\r
+ FOR i:= 2 TO BrojKraljica DO\r
+ Pom:= Tek;\r
+ NEW(Tek^.Sled);\r
+ Tek:= Tek^.Sled;\r
+ Tek^.Pre:= Pom;\r
+ END;\r
+ Tek^.Sled:= NIL;\r
+ END;\r
+ END Inicijalizacija;\r
+\r
+ PROCEDURE Ispitaj(Ko, Vr: INTEGER; Granica: PKraljica; VAR Stanje: StanjeTip; VAR Status: StatusTip);\r
+ VAR\r
+ Tek: PKraljica;\r
+ Jos: BOOLEAN;\r
+ BEGIN\r
+ WITH Stanje DO\r
+ Tek:= PrvaKra;\r
+ Jos:= Tek # Granica;\r
+ Status:= stSlobodno;\r
+ WHILE Jos DO\r
+ IF (Tek^.TekKo = Ko) AND (Tek^.TekVr = Vr) THEN\r
+ Status:= stZauzeto;\r
+ Jos:= FALSE;\r
+ ELSE\r
+ IF (Tek^.TekKo = Ko) OR (Tek^.TekVr = Vr) OR (ABS(Tek^.TekKo - Ko) = ABS(Tek^.TekVr - Vr)) THEN\r
+ Status:= stNapadnuto;\r
+ END;\r
+ IF Tek^.Sled= Granica THEN\r
+ Jos:= FALSE;\r
+ ELSE\r
+ Tek:= Tek^.Sled;\r
+ END;\r
+ END;\r
+ END;\r
+ END;\r
+ END Ispitaj;\r
+\r
+ PROCEDURE Stampa(VAR Resenje: ResenjeTip);\r
+ CONST\r
+ ImeFajla = "Resenje.txt";\r
+ VAR\r
+ Ko, Vr: INTEGER;\r
+ Izlaz: FIO.File;\r
+ BEGIN\r
+ IF FIO.Exists(ImeFajla) THEN\r
+ Izlaz:= FIO.Append(ImeFajla);\r
+ ELSE\r
+ Izlaz:= FIO.Create(ImeFajla);\r
+ END;\r
+ WrLn;\r
+ WrStr('-----------------------------------------------------------------');\r
+ WrStr('---------------');\r
+ WrLn;\r
+ FIO.WrLn(Izlaz);\r
+ WrStr('Kraljice treba staviti na sledeca polja:');\r
+ FIO.WrStr(Izlaz, 'Kraljice treba staviti na sledeca polja:');\r
+ WrLn;\r
+ FIO.WrLn(Izlaz);\r
+ FOR Vr:= BrojVrs TO 1 BY -1 DO\r
+ WrLn;\r
+ FIO.WrLn(Izlaz);\r
+ FOR Ko:= 1 TO BrojKol DO\r
+ CASE Resenje.Poz[Ko, Vr] OF\r
+ stZauzeto: WrStr(' Q');\r
+ FIO.WrStr(Izlaz, ' Q'); |\r
+ stNapadnuto: WrStr(' x');\r
+ FIO.WrStr(Izlaz, ' x');\r
+ ELSE\r
+ WrStr(' .');\r
+ FIO.WrStr(Izlaz, ' .');\r
+ END;\r
+ END;\r
+ END;\r
+ WrLn;\r
+ FIO.WrLn(Izlaz);\r
+ WrLn;\r
+ FIO.WrLn(Izlaz);\r
+ WrStr('Broj slobodnih polja je: ');\r
+ FIO.WrStr(Izlaz, 'Broj slobodnih polja je: ');\r
+ WrCard(BrojKol * BrojVrs - Resenje.Cena, 1);\r
+ FIO.WrCard(Izlaz, BrojKol * BrojVrs - Resenje.Cena, 1);\r
+ FIO.Close(Izlaz);\r
+ END Stampa;\r
+\r
+ PROCEDURE Dame(BrojKol, BrojVrs: INTEGER);\r
+ VAR\r
+ Stanje: StanjeTip;\r
+ Resenje: ResenjeTip;\r
+ MinCena: DomenCene;\r
+ Br: CARDINAL;\r
+\r
+ PROCEDURE NadjiKandidate(VAR Stanje: StanjeTip);\r
+\r
+ PROCEDURE NadjiCenu(k, v: INTEGER; VAR Cena: DomenCene; VAR Stanje: StanjeTip);\r
+ VAR\r
+ Ko, Vr: INTEGER;\r
+ Status: StatusTip;\r
+ BEGIN\r
+ Cena:= 0;\r
+ FOR Ko:= 1 TO BrojKol DO\r
+ FOR Vr:= 1 TO BrojVrs DO\r
+ IF (Ko # k) AND (Vr # v) AND (ABS(Ko - k) # ABS(Vr - v)) THEN\r
+ Ispitaj(Ko, Vr, Stanje.TekKra, Stanje, Status);\r
+ IF Status # stSlobodno THEN\r
+ INC(Cena);\r
+ END;\r
+ ELSE\r
+ INC(Cena);\r
+ END;\r
+ END;\r
+ END;\r
+ END NadjiCenu;\r
+\r
+ PROCEDURE Ubaci(VAR Prvi, Novi: PPolozaj);\r
+ VAR\r
+ Tek: PPolozaj;\r
+ BEGIN\r
+ IF (Prvi = NIL) OR (Novi^.Cena < Prvi^.Cena) THEN\r
+ Novi^.Veza:= Prvi;\r
+ Prvi:= Novi;\r
+ ELSE\r
+ Tek:= Prvi;\r
+ WHILE (Tek^.Veza # NIL) AND (Tek^.Veza^.Cena < Novi^.Cena) DO\r
+ Tek:= Tek^.Veza;\r
+ END;\r
+ Novi^.Veza:= Tek^.Veza;\r
+ Tek^.Veza:= Novi;\r
+ END;\r
+ END Ubaci;\r
+\r
+ VAR\r
+ k, v: INTEGER;\r
+ Temp, Prvi: PPolozaj;\r
+ NovaCena: DomenCene;\r
+ PocKol, PocVrs: INTEGER;\r
+\r
+ BEGIN\r
+ Prvi:= NIL;\r
+ IF Stanje.TekKra = Stanje.PrvaKra THEN\r
+ PocKol:= 1;\r
+ ELSE\r
+ PocKol:= Stanje.TekKra^.Pre^.TekKo;\r
+ END;\r
+ FOR k:= PocKol TO BrojKol DO\r
+ IF (k = PocKol) AND (Stanje.TekKra # Stanje.PrvaKra) THEN\r
+ PocVrs:= Stanje.TekKra^.Pre^.TekVr + 1;\r
+ ELSE\r
+ PocVrs:= 1;\r
+ END;\r
+ FOR v:= PocVrs TO BrojVrs DO\r
+ NadjiCenu(k, v, NovaCena, Stanje);\r
+ IF NovaCena < MinCena THEN\r
+ NEW(Temp);\r
+ WITH Temp^ DO\r
+ Veza:= NIL;\r
+ Ko:= k;\r
+ Vr:= v;\r
+ Cena:= NovaCena;\r
+ END;\r
+ Ubaci(Prvi, Temp);\r
+ END;\r
+ END;\r
+ END;\r
+ Stanje.TekKra^.Kandidati:= Prvi;\r
+ END NadjiKandidate;\r
+\r
+ PROCEDURE ZapamtiResenje(VAR Stanje: StanjeTip; VAR Resenje: ResenjeTip);\r
+ VAR\r
+ Ko, Vr: INTEGER;\r
+ Status: StatusTip;\r
+ BEGIN\r
+ Resenje.Cena:= Stanje.Cena;\r
+ FOR Ko:= 1 TO BrojKol DO\r
+ FOR Vr:= 1 TO BrojVrs DO\r
+ Ispitaj(Ko, Vr, NIL, Stanje, Status);\r
+ Resenje.Poz[Ko, Vr]:= Status;\r
+ END;\r
+ END;\r
+ END ZapamtiResenje;\r
+\r
+ BEGIN\r
+ Inicijalizacija(Stanje, Br);\r
+ MinCena:= BrojKol * BrojVrs + 1;\r
+ NadjiKandidate(Stanje);\r
+ WITH Stanje DO\r
+ WHILE TekKra # NIL DO\r
+ WHILE TekKra^.Kandidati # NIL DO\r
+ IF TekKra = PrvaKra THEN\r
+ INC(Br);\r
+ WrCard(Br, 4);\r
+ END;\r
+ Postavi(Stanje);\r
+ IF TekKra^.Sled = NIL THEN\r
+ IF Cena < MinCena THEN\r
+ MinCena:= Cena;\r
+ ZapamtiResenje(Stanje, Resenje);\r
+ END;\r
+ ELSE\r
+ TekKra:= TekKra^.Sled;\r
+ NadjiKandidate(Stanje);\r
+ END;\r
+ END;\r
+ TekKra:= TekKra^.Pre;\r
+ END;\r
+ Stampa(Resenje);\r
+ END;\r
+ END Dame;\r
+\r
+ VAR\r
+ as,df : Interval;\r
+ \r
+BEGIN\r
+ Unos();\r
+ WrLn;\r
+ WrStr('Sacekajte !!!');\r
+ WrLn;\r
+ Dame(BrojKol, BrojVrs);\r
+ as := 5;\r
+ df := 6;\r
+END Queens2.\r