DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ R T

⟦e9a9879a7⟧ TextFile

    Length: 8892 (0x22bc)
    Types: TextFile
    Names: »REINE_ADA«

Derivation

└─⟦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

--
-- Christophe MARCHAL
-- Probleme des 8 reines
-- sous FADA version 4 : 3 mars 1991
--

with expertSystem,chrono;
use  expertSystem;
package reines is
	subtype tTaille is natural range 0..9;		-- jusqu'a 9 reines
	type rangee is array(tTaille) of tTaille;
	type object is record
		echiquier : rangee  := (others=>0) ;
		niveau    : tTaille :=0 ;
		ouvert    : boolean := FALSE ;
	end record;

	RangCourant : tTaille  :=0;		-- rangee courante
	RangFinal   : tTaille  :=tTaille'LAST;	-- but a atteindre

	procedure enRoute           (nbreReine : natural);
	function  niveauNonOuvert   (niveau    : tTaille) return collection.object;
	function  niveauFinal       (niveau    : tTaille) return collection.object;
	procedure afficherSol       (sol       : collection.object);
	procedure ajoutSituation    (sit       : expertSystem.reference;
				     rang      : tTaille;
				     colonne   : tTaille);
	procedure fermeSituation    (sit       : expertSystem.reference);
	function  situationCorrecte (sit       : expertSystem.reference;
				     rang      : tTaille;
				     colonne   : tTaille) return boolean;
end reines;

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;

with expertSystem; use  expertSystem;
with Reines;        use  Reines;
with Chrono;

package systExpertR is
	procedure enRoute(nbreReine : natural ; affDem : boolean);
	function  continue return boolean;
end systExpertR;

package body systExpertR is
			-- les variables internes :

	type tContexte is (contexte0, contexte1, contexte2);
	contexte: tContexte := contexte0;

			-- les variables de l'application :
	buts       : collection   .object;
	solutions  : collection   .object; 
	situation  : expertSystem.reference;
	affDemande : boolean      := TRUE;	-- affichage demande ?

			-- regles a utiliser dans le contexte 0 :
	function regle0 return boolean is
	begin

-- R-0-A
--    SI    LE RANG COURANT DANS L'ECHIQUIER EST EGAL AU RANG A ATTEINDRE
-- ET SI    L'ENSEMBLE DES SOLUTIONS EST VIDE
--    ALORS REMPLIR L'ENSEMBLE DES SOLUTIONS AVEC LES SITUATIONS DE NIVEAU 
--	    COURANT (QUI ONT DEJA ETE OUVERTES)

	regleTrouverSolution:
	begin
		if  RangCourant = RangFinal
		and collection.cardinality(solutions)=0
		then
		    solutions := niveauFinal(RangFinal); 
		    return( TRUE ) ;
		end if;
	end regleTrouverSolution;

-- R-0-B
--    SI    L'ENSEMBLE DES SOLUTIONS N'EST PAS VIDE
--    ALORS AFFICHER SON CONTENU

	regleAfficherSol:
	begin
		if collection.cardinality(solutions)/=0
		then
		    chrono.stop(0);
		    if affDemande then
		       afficherSol(solutions);
		    end if;
		    return( FALSE ) ;			-- F I N I !
		end if;
	end regleAfficherSol;

-- R-0-C
--    SI    LE RANG COURANT DANS L'ECHIQUIER EST DIFFERENT DU RANG A ATTEINDRE
-- ET SI    L'ENSEMBLE DES BUTS EST VIDE
--    ALORS REMPLIR L'ENSEMBLE DES BUTS AVEC LES SITUATIONS DE NIVEAU COURANT 
--          NON ENCORE OUVERTES

	regleChercherBut:
	begin
		if  RangCourant /= RangFinal
		and collection.cardinality(buts)=0
		then
		    buts := niveauNonOuvert(RangCourant);
		    put(" Nb buts niveau courant :");
		    put(integer(collection.cardinality(buts)));
		    put_line("  ");
		    return( TRUE ) ;
		end if;
	end regleChercherBut;

-- R-0-D
--    SI    L'ENSEMBLE DES BUTS N'EST PAS VIDE
--    ALORS COMMENCER / CONTINUER A TRAITER SON CONTENU

	regleTraiterBut:
	begin
		if collection.cardinality(buts)/=0
		then
		   RangCourant := RangCourant + 1;
		   situation:=collection.first(buts);
		   for essai in 1..RangFinal loop
		       if situationCorrecte(situation,RangCourant,essai) then
			  ajoutSituation(situation,RangCourant,essai);
		       end if;
		   end loop;
		   fermeSituation(situation);
		   collection.remove(buts,situation);
		   if collection.cardinality(buts)/=0 then
		      RangCourant := RangCourant-1; -- continuer au meme niveau
		   end if;			    -- tq ens Buts pas vide
		   return( TRUE ) ;
		end if;
	end regleTraiterBut;

-- etc ... autres regles du contexte 0


		return (FALSE);		-- fin des regles de REGLE0

	end regle0;


-- MISE EN ROUTE DU MOTEUR DU S-E

	procedure enRoute(nbreReine : natural ; 
			  affDem    : boolean ) is
	begin

				-- initialisations

		affDemande:=affDem;
		collection.clear(buts);
		collection.clear(solutions);
		reines.enRoute(nbreReine);

	end enRoute;


-- ENTRETIENT DU MOTEUR DU S-E

	function continue return boolean is
		resu : boolean;
	begin
		case contexte is
			when contexte0 => resu:=regle0;
--			when contexte1 => resu:=regle1;
			when others    => resu:=FALSE;
		end case;
		return(resu);
	end continue;

end systExpertR;


with expertSystem,systExpertR,chrono ; 
use  expertSystem;
  procedure Reine is
nc   : character;
ni   : integer;
zero : constant natural := character'POS('0');
begin
    put_line("Resolution du probleme des N reines");
    put("Tapez un nombre entre 4 et 9  ");
    get(nc);
    put_line(" ");
    ni:=character'pos(nc)-zero;
    systExpertR.enRoute(ni,TRUE);
    loop
	exit when not systExpertR.continue;
    end loop;

end Reine;

with expertSystem,systExpertR,chrono ; 
use  expertSystem;
  procedure Mesure is
cpt : natural;
begin
    put_line("Resolution du probleme des N reines");
    put_line("Mesure des temps : ");
    chrono.reset;
    for ni in 4..9 loop
       cpt:=1;
       chrono.start(ni);
       systExpertR.enRoute(ni,FALSE);
       loop
	   exit when not systExpertR.continue;
           cpt:=cpt+1;
       end loop;
       chrono.next(cpt);
    end loop;
    put_line("  ESSAI  REINES  REGLES DUREE");
    chrono.display;
end Mesure;