|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 6755 (0x1a63)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦01fad8ca6⟧
└─⟦this⟧
--
-- Christophe MARCHAL
-- Probleme des 8 reines
-- sous FADA version 4 :15 avril 1991
-- version avec ENGINE normalise
-- descente en profondeur
--
with expertSystem,chrono;
use expertSystem;
package Reines2 is
procedure enRoute(nbreReine : natural ; affDem : boolean);
function continue return boolean;
end Reines2;
with expertSystem,chrono;
use expertSystem;
package body Reines2 is
NbReste:natural:=0;
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) ;
rang : tTaille :=0 ;
niveau : tTaille :=0 ;
end record;
type supportObject is record
name : string(1..10):="wood table";
here : string(1..6) :="saloon";
end record;
RangFinal : tTaille :=tTaille'LAST; -- but a atteindre (hauteur)
NivoFinal : tTaille :=tTaille'LAST; -- but a atteindre (largeur)
affDemande : boolean := TRUE;
package behavior is new classBehavior(object,"QUEEN ",3000);
package support is new classBehavior(supportObject,"CHESSBOARD");
procedure enRoute(nbreReine : natural ;
affDem : boolean ) is
init : object;
init1 : supportObject;
begin
if affDem then
debugger.resetDebug(debugger.text);
debugger.refreshDebug;
end if;
affDemande:=affDem;
RangFinal:=tTaille(nbreReine);
NivoFinal:=RangFinal;
behavior.clear;
init.echiquier:=(others=>0);
init.rang:=0;
init.niveau:=0;
behavior.allocate(init);
support.clear;
support.allocate(init1);
end enRoute;
procedure ajoutSituation (sit : expertSystem.reference;
rang : tTaille;
colonne : tTaille) is
situation : Reines2.object;
begin
situation := behavior.get(sit);
situation.echiquier(rang) := colonne;
situation.rang := situation.rang+1;
situation.niveau := 0;
behavior.allocate(situation);
end ajoutSituation;
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 : Reines2.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))
then return (FALSE);
end if;
end loop;
return TRUE;
end situationCorrecte;
function rangTerminal return tupleCollection.object is
function rangFin ( r1,r2 : expertSystem.reference) return boolean is
begin
return( behavior.get(r1).rang = rangFinal ) ;
end rangFin;
function cesRangs is new tupleCollection.join2(rangFin);
begin
return(cesRangs(behavior.instances,support.instances));
end rangTerminal;
procedure dessine(n : natural) is
begin
for i in 1..n-1 loop put("| "); end loop;
if n/=0 then put("| o "); end if;
for i in n+1..RangFinal loop put("| "); end loop;
put_line("|");
end dessine;
procedure affiche(uneRef : expertSystem.reference) is
begin
for i in 1..4*RangFinal+1 loop put("="); end loop; put_line(" ");
for i in 1..RangFinal loop
dessine(Reines2.behavior.get(UneRef).echiquier(i));
for i in 1..4*RangFinal+1 loop put("="); end loop; put_line(" ");
end loop;
end affiche;
procedure afficherSol( sol : tuple.object) is
begin
if affDemande then
put_line(" ");
put_line("Voici une solution : ");
affiche(tuple.first(sol));
end if;
behavior.dispose(tuple.first(sol));
end afficherSol;
function rangOuvert return tupleCollection.object is
tc : tupleCollection.object;
function rangEtOuvert(r1,r2 : expertSystem.reference) return boolean is
begin
return( behavior.get(r1).niveau = nivoFinal );
end rangEtOuvert;
function lesRangs is new tupleCollection.join2(rangEtOuvert);
begin
tc:= lesRangs(behavior.instances,support.instances);
NbReste:=tupleCollection.cardinality(tc);
return tc;
end rangOuvert;
procedure fermer( echiquier : tuple.object) is
sit : expertSystem.reference;
situation : Reines2.object;
begin
sit:=tuple.first(echiquier);
situation:=behavior.get(sit);
situation.niveau:=nivoFinal;
behavior.set(sit,situation);
behavior.dispose(sit); -- suppression des situations inutiles
end fermer;
function rangNonOuvert return tupleCollection.object is
function rangEtPasOuvert(r1,r2 : expertSystem.reference) return boolean is
begin
return(
behavior.get(r1).niveau /= nivoFinal );
end rangEtPasOuvert;
function lesRangs is new tupleCollection.join2(rangEtPasOuvert);
begin
return lesRangs(behavior.instances,support.instances);
end rangNonOuvert;
procedure ouvrir( echiquier : tuple.object) is
situation : Reines2.object;
sit : expertSystem.reference;
essai : natural;
begin
sit:=tuple.first(echiquier);
situation := behavior.get(sit);
if situationCorrecte(sit,situation.rang+1,situation.niveau+1) then
ajoutSituation(sit,situation.rang+1,situation.niveau+1);
end if;
situation.niveau:=situation.niveau+1;
behavior.set(sit,situation);
end ouvrir;
package tenAge is new engine(
context_name => "the Queens",
resolution => LEX,
used_rules => 3,
name_1 => "last level down",
condition_1 => rangTerminal,
action_1 => afficherSol,
name_2 => "last level righ",
condition_2 => rangOuvert,
action_2 => fermer,
name_3 => "go to right ",
condition_3 => rangNonOuvert,
action_3 => ouvrir);
function continue return boolean is
begin
return (tenAge.inference(1)) ;
end continue;
end Reines2;
with expertSystem,Reines2,chrono ;
use expertSystem;
procedure Reine2 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;
Reines2.enRoute(ni,TRUE);
loop
exit when not Reines2.continue;
end loop;
end Reine2;
with expertSystem,Reines2,chrono ;
use expertSystem;
procedure Mesure2 is
cpt : natural;
begin
put_line("Resolution du probleme des N reines");
put_line("Mesure2 des temps : ");
chrono.reset;
for ni in 4..9 loop
cpt:=1;
chrono.start(ni);
Reines2.enRoute(ni,FALSE);
loop
exit when not Reines2.continue;
cpt:=cpt+1;
end loop;
chrono.stop(cpt);
chrono.next(cpt);
end loop;
put_line(" ESSAI REINES REGLES DUREE");
chrono.display;
end Mesure2;