gitweb on Svarog

projekti pod git sistemom za održavanje verzija -- projects under the git version control system
Dodao XDS resenje za obrnuti problem kraljica.
authorIvan Pribela <ivanpribela@gmail.com>
Sat, 16 Nov 2013 17:06:46 +0000 (18:06 +0100)
committerIvan 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]

diff --git a/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD b/10. Obrnuti problem kraljica/XDS/QUEENS2.MOD
new file mode 100644 (file)
index 0000000..a1356a8
--- /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
Svarog.pmf.uns.ac.rs/gitweb maintanance Doni Pracner