|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 16896 (0x4200)
Types: TextFile
Names: »tnim«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »tnim«
Program Demon-3. NIM.
begin
boolean first, manwins, lastwins, newsafe, oldsafe, mannext,
settled, oddones;
integer linerest, oldran, lang, groups, actualgroup, draw, ones,
notone, biggestgroup, bestgroup, nmax, n, bit, g;
long number, factor, maxpossible, possible, boolesum, groupboole,
removed, maxgroup;
long array Group(1:10);
comment\f
-2- Demon-3
;
long procedure Asknumber(dan, eng, fr, ger);
string dan, eng, fr, ger;
begin
Writetext(dan, eng, fr, ger);
write(out,<:::>);
outend(32);
Asknumber:= Readlong;
Checkline
end Asknumber;
comment\f
-3- Demon-3
;
procedure Checkline;
begin
integer j;
repeatchar(in);
if Skip(j, j < 8) <> 10 then
Line else linerest:= linerest - 1
end Checkline;
comment\f
-4- Demon-3
;
procedure Game(man, machine, mannext);
boolean man, machine, mannext;
begin
boolean finished, Man, Machine;
Man:= Machine:= finished:= false;
draw:= if mannext then 0 else -1;
for draw:= draw + 1 while -,finished do
begin
if mannext then Man:= man else Machine:= machine;
mannext:= -,mannext;
finished:= Man or Machine
end for draw
end Game;
comment\f
-5- Demon-3
;
long procedure Groupsum;
begin
long sum;
sum:= 0;
for g:= 1 step 1 until groups do sum:= sum + Group(g);
Groupsum:= sum
end Groupsum;
comment\f
-6- Demon-3
;
procedure Line;
if linerest < 8 then Newpage
else
begin
linerest:= linerest - 1;
outchar(out,10)
end Line;
comment\f
-7- Demon-3
;
boolean procedure Machine;
begin
settled:= false;
Strategy(Safe, None, biggestgroup, extend 1);
comment that was the Strategy if safe for man,
i. e. unsafe for machine;
Strategy(-,lastwins => notone > 1, Normaltest, bestgroup,
maxpossible);
comment that was the Strategy if last wins or (last looses and more
than one group containing more than one);
Strategy(true, Specialtest, bestgroup, possible);
comment that was the Strategy if last looses and not more than one
group with more than one;
Group(actualgroup):= Group(actualgroup) - removed;
Writetext(
<:Jeg fjerner:>, <:I remove:>,
<:Je prends:>, <:Ich nehme:>);
if Group(actualgroup) = 0 then Writetext(
<: hele bunke nr.:>, <: the entire group no.:>,
<: tout le groupe no.:>, <: den ganzen Haufen nr.:>)
else
begin
write(out, removed);
Writetext(
<: fra bunke nr.:>, <: from group no.:>,
<: du groupe no.:>, <: von Haufen nr.:>)
end if not empty;
write(out, actualgroup);
Writetext(
<:. Bunkerne indeholder nu::>, <:. The groups now contain::>,
<:. Les groupes contiennent::>, <:. Die Haufen enthalten jetzt::>);
Line;
Printgroups;
Line;
Machine:= Groupsum = 0;
manwins:= -,lastwins
end Machine;
comment\f
-8- Demon-3
;
boolean procedure Man;
begin
AA:
actualgroup:= if first then Asknumber(
<:Skriv nummeret på den bunke, fra hvilken De vil fjerne tændstikker:>,
<:Write the number of the group from which you will remove matches:>,
<:Ecrivez le numero du groupe dont vous voulez prendre des allumettes:>,
<:Schreiben sie die Nummer des Haufens, von dem sie Hoelzer wegnehmen:>)
else Asknumber(
<:Vælg Deres bunke:>, <:Choose your group:>,
<:Choisissez votre groupe:>, <:Bitte Haufen waehlen:>);
if actualgroup < 1 or actualgroup > groups then
begin
Writetext(
<:Undskyld, men tallet er for :>,
<:Sorry, but the number is too :>,
<:Pardon, le nombre est trop :>,
<:Die Zahl ist zu :>);
if actualgroup < 1 then Writetext(
<:lille.:>, <:low.:>, <:petit.:>, <:klein.:>)
else Writetext(
<:stort.:>, <:high.:>, <:grand.:>, <:gross.:>);
Line;
goto AA
end if out of range;
if Group(actualgroup) = 0 then
begin
Writetext(
<:Undskyld, men denne bunke er tom.:>,
<:Sorry, but this group is empty.:>,
<:Pardon, ce groupe est vide.:>,
<:Dieser Haufen ist leer.:>);
Line;
goto AA
end if empty group;
removed:= Group(actualgroup);
if removed <> 1 then
begin
BB:
removed:= if first then
Asknumber(
<:Og antallet af tændstikker, De vil fjerne:>,
<:And the number of matches you want to remove:>,
<:Et le nombre d'allumettes que vous prenez:>,
<:Und die Anzahl der Zuendhoelzer, die Sie wegnehmen:>)
else Asknumber(
<:Og antallet:>, <:And the number:>,
<:Et le nombre:>, <:Und die Anzahl:>);
if removed < 1 then
begin
Writetext(
<:De skal fjerne mindst een tændstik.:>,
<:You must remove at least one match:>,
<:Il faut prendre au moins une allumette.:>,
<:Sie muessen mindestens ein Zuendholz wegnehmen.:>);
Line;
goto BB
end if removed < 1;
comment\f
-9- Demon-3
;
if removed > Group(actualgroup) then
begin
Writetext(
<:Så mange er der ikke i bunken. De fjerner altså hele bunken.:>,
<:There are not so many in the group. You are removing the whole group.:>,
<:Il n'y en pas tant. Vous prenez donc tout le groupe.:>,
<:So viele sind da nicht. Sie nehmen also den ganzen Haufen.:>);
Line;
removed:= Group(actualgroup)
end if too many
end if more than one;
Group(actualgroup):= Group(actualgroup) - removed;
first:= false;
newsafe:= Safe;
if draw = 1 then
begin
Line;
if newsafe then Writetext(
<:Hvis De spiller rigtigt, kan De vinde dette spil.:>,
<:If you play correctly, you may win this game.:>,
<:Si vous jouez correctement, vous pouvez gagner ce jeu.:>,
<:Wenn Sie richtig spielen, koennen Sie dieses Spiel gewinnen.:>)
else Writetext(
<:De kan ikke vinde dette spil.:>,
<:You cannot win this game.:>,
<:Vous ne pouvez pas gagner ce jeu.:>,
<:Sie koennen dieses Spiel nicht gewinnen.:>);
Line;
Line
end if draw = 1
else
if oldsafe and -,newsafe then
begin
Line;
Writetext(
<:Det var forkert. Nu kan de ikke vinde.:>,
<:That was wrong. You cannot win now.:>,
<:Voila une erreur. Maintenant vois ne pouvez pas gagner.:>,
<:Das was falsch. Jetzt koennen Sie dieses Spiel nicht mehr gewinnen.:>);
Line;
Line
end if blunder;
oldsafe:= newsafe;
if -,newsafe and draw mod 3 = 0 then
begin
if Question(
<:Giver De fortabt:>, <:Do you want to give up the game:>,
<:Vous vous declarez vaincu:>, <:Wollen Sie aufgeben:>) then
begin
Man:= true;
manwins:= false;
goto EX
end give up
end Question;
Man:= Groupsum = 0;
manwins:= lastwins;
EX:
end Man;
comment\f
-10- Demon-3
;
procedure Newpage;
for linerest:= linerest - 1 while linerest >= 0, 69 do outchar(out,10);
comment\f
-11- Demon-3
;
procedure None;
;
comment\f
-12- Demon-3
;
procedure Normaltest;
begin
number:= boolesum;
factor:= 1;
nmax:= 48;
for nmax:= nmax - 1 while number // factor >= 1 do
factor:= 2 * factor;
for g:= 1 step 1 until groups do
begin
if number = Group(g) then
begin
bestgroup:= g;
maxpossible:= number;
goto EX
end if all removed
else
begin
groupboole:= Group(g);
if sgn(groupboole shift (nmax+1)) = -1 then bestgroup:= g
end if not all removed
end for g;
maxpossible:= 0;
factor:= 1;
groupboole:= Group(bestgroup);
for n:= 47 step -1 until nmax do
begin
if sgn(boolesum shift n) = -1 then
maxpossible:= maxpossible - sgn(groupboole shift n) * factor;
factor:= 2 * factor
end for n;
EX:
end normal test;
comment\f
-13- Demon-3
;
procedure Printgroups;
for g:= 1 step 1 until groups do
write(out,<<-ddd>, Group(g));
comment\f
-14- Demon-3
;
boolean procedure Question(dan, eng, fr, ger);
string dan, eng, fr, ger;
begin
real array txt(1:1);
integer j;
Writetext(dan, eng, fr, ger);
outchar(out,63);
outend(32);
Skip(j, j > 6);
repeatchar(in);
j:= 1;
readstring(in,txt,j);
Checkline;
Question:= if txt(1) = real (case lang of(
<:nej:>, <:no:>, <:non:>, <:nein:>))
then false else
if txt(1) = real (case lang of(
<:ja:>, <:yes:>, <:oui:>, <:ja:>))
then true else
Question(dan, eng, fr, ger)
end Question;
comment\f
-15- Demon-3
;
integer procedure Randominteger(n);
value n;
integer n;
begin
random(oldran);
Randominteger:= oldran mod (n+1)
end Randominteger from 0 to n;
comment\f
-16- Demon-3
;
long procedure Readlong;
begin
integer j;
long val;
Skip(j, j > 5);
repeatchar(in);
read(in,val);
repeatchar(in);
Readlong:= val
end Readlong;
comment\f
-17- Demon-3
;
boolean procedure Safe;
begin
boolesum:= 0;
ones:= notone:= 0;
biggestgroup:= 1;
maxgroup:= Group(1);
for g:= 1 step 1 until groups do
begin
number:= Group(g);
if number > 1 then notone:= notone + 1;
if number = 1 then ones:= ones + 1;
if number > maxgroup then
begin
maxgroup:= number;
biggestgroup:= g
end if bigger;
groupboole:= number;
boolesum:= logor(logand(boolesum,-groupboole-1),
logand(-boolesum-1,groupboole))
end for g;
number:= boolesum;
oddones:= ones // 2 * 2 <> ones;
Safe:= if -,lastwins and notone = 0 then oddones else number = 0
end Safe;
comment\f
-18- Demon-3
;
procedure Selectlanguage;
begin
integer j;
Line;
write(out,
<:Select language: d: danish, e: english, f: french, g: german.:>);
outend(32);
lang:= Skip(j, j > 6) - 99;
Checkline;
if lang < 1 then lang:= 1;
if lang > 4 then lang:= 4;
Writetext(
<:Dansk:>, <:English:>, <:Francais:>, <:Deutsch:>);
Line
end Selectlanguage;
comment\f
-19- Demon-3
;
procedure Shiftpage(n);
value n;
integer n;
if linerest < n-8 then Newpage else Line;
comment\f
-20- Demon-3
;
integer procedure Skip(class, condition);
integer class;
boolean condition;
begin
integer i;
for class:= readchar(in, i) while condition do
if i = 10 then linerest:= linerest - 1;
Skip:= i
end Skip;
comment\f
-21- Demon-3
;
procedure Specialtest;
begin
for bestgroup:= 1 step 1 until groups do
begin
number:= Group(bestgroup);
if number > 1 then
begin
possible:= if oddones then number else number - 1;
goto EX
end if number > 1;
if notone = 0 and number = 1 then
begin
possible:= 1;
goto EX
end if only ones
end for best group;
EX:
end Specialtest;
comment\f
-22- Demon-3
;
procedure Strategy(condition, Test, bestgroup, take);
boolean condition;
procedure Test;
integer bestgroup;
long take;
if condition and -,settled then
begin
Test;
actualgroup:= bestgroup;
removed:= take;
settled:= true
end if and Strategy;
comment\f
-23- Demon-3
;
procedure Writetext(dan, eng, fr, ger);
string dan, eng, fr, ger;
write(out, case lang of (dan, eng, fr, ger));
comment\f
-24- Demon-3
;
linerest:= 69;
Selectlanguage;
oldran:= getclock extract 22;
Line;
Writetext(
<:Program Demon-3:>, <:Program Demon-3:>,
<:Programme Demon-3:>, <:Programm Demon-3:>);
Line;
Writetext(
<:Tændstikspillet NIM.
Vi vælger først nogle tilfældige bunker af tændstikker::>,
<:The match game NIM.
We first select some random groups of matches::>,
<:Le jeu de NIM.
Nous choisissons d'abord quelques groupes d'allumettes::>,
<:Das Spiel NIM.
Wir waehlen zuerst einigen Haufen von Tuendhoelzern::>);
linerest:= linerest - 1;
Line;
Line;
Writetext(
<:Bunke nr.: :>, <:Group no.: :>,
<:Groupe no.: :>, <:Haufen nr.: :>);
groups:= 3;
for g:= 1 step 1 until groups do write(out, <<-ddd>, g);
Line;
Writetext(
<:Antal Tændstikker: :>, <:Number of matches: :>,
<:Nombre d'allumettes: :>, <:Anzahl Hoelzer: :>);
for g:= 1 step 1 until groups do
Group(g):= 1 + Randominteger(6);
Printgroups;
Line;
Line;
Writetext(
<:Vi skal nu skiftevis fjerne tændstikker fra bunkerne. Den, som fjerner
den eller de sidste tændstikker, har vundet. Kun een bunke må røres i hvert
træk, og man skal fjerne mindst een tændstik fra den bunke.:>,
<:We shall now alternatingly remove matches from the groups. He who removes
the last match (or matches) has won. In each move only one group must be
touched, and at least one match must be removed from that group:>,
<:Nous allons alternativement enlever des allumettes des groupes. Celui qui
prend la derniere allumette est vainqueur. Dans chaque coup if faut
toucher un groupe seulement et prendre au moins une allumette.:>,
<:Wir sollen jetzt abwechselnd Zuendhoelzer von den Haufen wegnehmen.
Derjenige, der das Letzte nimmt, hat gewonnen. In jedem Zug darf man nur
einen Haufen ruehren, und man soll mindestens ein Zuendhoelz wegnehmen.:>);
linerest:= linerest - 2;
Line;
Line;
draw:= 0;
first:= lastwins:= true;
mannext:= false;
Writetext(
<:Jeg begynder.:>, <:I begin.:>,
<:Je commence.:>, <:Ich fange an.:>);
comment\f
-25- Demon-3
;
AA:
Line;
Game(Man, Machine, mannext);
if manwins then Writetext(
<:De har vundet. Tillykke.:>,
<:You have von. Congratulations.:>,
<:Vous etes vainqueur. Mes felicitations.:>,
<:Sie haben gewonnen. Ich gratuliere Ihnen.:>)
else
Writetext(
<:De har tabt.:>, <:You have lost.:>,
<:Vous avez perdu.:>, <:Sie haben verloren.:>);
Line;
if Question(
<:Skal vi prøve igen:>, <:Shall we try again:>,
<:Voulez vous jouer encore:>, <:Sollen wir nochmals spielen:>) then
begin
Shiftpage(40);
groups:= Asknumber(
<:Hvor mange bunker:>, <:How many groups:>,
<:Combien de groupes:>, <:Wieviel Haufen:>);
if groups < 2 or groups > 10 then
begin
groups:= if groups < 2 then 2 else 10;
Line;
write(out,<<dd>, groups);
Writetext(
<: er bedre.:>, <: is better.:>,
<: va mieux.:>, <: ist besser.:>)
end if out of range;
if Question(
<:Ønsker De selv at bestemme antallet af tændstikker:>,
<:Do you want to specify the number of matches:>,
<:Voulez vous specifier le nombre des allumettes:>,
<:Wollen Sie die Anzahl der Tuendhoelzer angeben:>) then
begin
Writetext(
<:Skriv dem her::>, <:Write them here::>,
<:Ecrivez les ici::>, <:Schreiben Sie ihnen hier::>);
Line;
outend(0);
for g:= 1 step 1 until groups do Group(g):= Readlong;
Checkline
end
else
begin
Writetext(
<:Her er bunkerne:>, <:Here are the groups:>,
<:Voici les groupes:>, <:Hier sind die Haufen:>);
Line;
comment\f
-26- Demon-3
;
for g:= 1 step 1 until groups do
Group(g):= 1 + Randominteger(2**groups - 2);
Printgroups;
Line
end;
mannext:= Question(
<:Vil De begynde:>, <:Do you want to begin:>,
<:Voulez vous commencier:>, <:Wollen Sie anfangen:>);
lastwins:= Question(
<:Skal den, som tager sidste tændstik, vinde:>,
<:Must he who takes the last match win:>,
<:Celui qui prend la derniere allumette, est-il vainqueur:>,
<:Hat Derjenige, der das Letzte nimmt, gewonnen:>);
draw:= 0;
Line;
goto AA
end if more games
end program;
▶EOF◀