DataMuseum.dk

top - download

    Length: 4168 (0x1048)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Expertsystem, Chrono;
use Expertsystem;
package body Reines is
    package Behavior is new Classbehavior (Object, "QUEEN     ", 3000);
    procedure Enroute (Nbrereine : Natural) is
        Init : Reines.Object;
    begin
        Rangcourant := 0;
        Rangfinal := Ttaille (Nbrereine);
        Behavior.Clear;
        Init.Echiquier := (others => 0);
        Init.Niveau := 0;
        Init.Ouvert := False;
        Behavior.Allocate (Init);
    end Enroute;


    function Niveaunonouvert (Niveau : Ttaille) return Collection.Object is
        function Niveauetpasouvert
                    (Uneref : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (Uneref).Niveau = Niveau and
                    Behavior.Get (Uneref).Ouvert = False);
        end Niveauetpasouvert;
        function Lesniveaux is new Collection.Restrict (Niveauetpasouvert);
    begin
        return Lesniveaux (Behavior.Instances);
    end Niveaunonouvert;

    function Niveaufinal (Niveau : Ttaille) return Collection.Object is
        function Niveaufin (Uneref : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (Uneref).Niveau = Niveau);
        end Niveaufin;
        function Cesniveaux is new Collection.Restrict (Niveaufin);
    begin
        return (Cesniveaux (Behavior.Instances));
    end Niveaufinal;

    procedure Dessine (N : Natural) is
    begin
        for I in 1 .. N - 1 loop
            Put ("|   ");
        end loop;
        Put ("| o ");
        for I in N + 1 .. Rangfinal loop
            Put ("|   ");
        end loop;
        Put_Line ("|");
    end Dessine;
    procedure Affiche (Uneref : Expertsystem.Reference) is
    begin
        Put_Line (" ");
        Put_Line ("Voici une solution : ");
        for I in 1 .. 4 * Rangfinal + 1 loop
            Put ("=");
        end loop;
        Put_Line (" ");
        for I in 1 .. Rangfinal loop
            Dessine (Reines.Behavior.Get (Uneref).Echiquier (I));
            for I in 1 .. 4 * Rangfinal + 1 loop
                Put ("=");
            end loop;
            Put_Line (" ");
        end loop;
    end Affiche;
    procedure Lesafficher is new Collection.Forall (Affiche);
    procedure Affichersol (Sol : Collection.Object) is
    begin
        Put ("Nombre de solutions :");
        Put (Integer (Collection.Cardinality (Sol)));
        Put_Line ("  ");
        Lesafficher (Sol);
    end Affichersol;

    procedure Ajoutsituation (Sit : Expertsystem.Reference;
                              Rang : Ttaille;
                              Colonne : Ttaille) is
        Situation : Reines.Object;
    begin
        Situation := Behavior.Get (Sit);
        Situation.Echiquier (Rang) := Colonne;
        Situation.Niveau := Situation.Niveau + 1;
        Situation.Ouvert := False;
        Behavior.Allocate (Situation);
    end Ajoutsituation;

    procedure Fermesituation (Sit : Expertsystem.Reference) is
        Situation : Reines.Object;
    begin
        Situation := Behavior.Get (Sit);
        Situation.Ouvert := True;
        Behavior.Set (Sit, Situation);

        Behavior.Dispose (Sit);  -- suppression des situations inutiles
    end Fermesituation;

    function Situationcorrecte
                (Sit : Expertsystem.Reference; -- echiquier courant
                 Rang : Ttaille;           -- nouvelle ligne
                 Colonne : Ttaille)           -- position reine dans
                return Boolean is               -- la ligne
-- rend VRAI si une reine peut etre mise en (rang,colonne) sans risque du aux
-- autres reines etant deja sur l'echiquier sur les lignes 1..rang-1
        Situation : Reines.Object;
    begin
        Situation := Behavior.Get (Sit);
        for Ligne in 1 .. Rang - 1 loop
            if Situation.Echiquier (Ligne) = Colonne          -- meme colonne
                or
               Rang - Ligne =
                  abs (Colonne -
                       Situation.Echiquier (Ligne)) -- meme diagonale a gauche
                then
                return (False);
            end if;
        end loop;
        return True;
    end Situationcorrecte;

end Reines;