Hello everybody!
I need your help to improve the calcul method of a program.
This program is called "le compte est bon" and consist in making the
computer
calculate a given random number with six other numbers ("plaquettes")
and
the operations {*, /,+, -}. It uses each of the six numbers only once
and if it do
not find, gives the best approximation.
I've already done something, but the program is not "intelligent"
enough.
So, if you have ideas, put your modifications in an other color in
the source
and send it back, thank you!
Here's the source code:
PROGRAM Le_compte_est_bon;
uses crt;
type table=array [100..999] of integer;
type sac=array [1..69] of integer;
type position=array[1..6] of integer;
var p:position;
type fableau=array[1..15] of integer;
var f:fableau;
type gableau=array[1..4] of integer;
var g:gableau;
type hableau=array[1..18] of integer;
var h:hableau;
type qableau=array[1..4] of integer;
var q:qableau;
var nb,min,minus,micro,u,v:integer;
Procedure remplit_sac (var s:sac);
var k:integer;
begin
for k:=1 to 10 do s[k]:=1;
for k:=11 to 20 do s[k]:=2;
for k:=21 to 25 do s[k]:=3;
for k:=26 to 30 do s[k]:=4;
for k:=31 to 35 do s[k]:=5;
for k:=36 to 40 do s[k]:=6;
for k:=41 to 45 do s[k]:=7;
for k:=46 to 50 do s[k]:=8;
for k:=51 to 55 do s[k]:=9;
for k:=56 to 59 do s[k]:=10;
for k:=60 to 62 do s[k]:=25;
for k:=63 to 65 do s[k]:=50;
for k:=66 to 67 do s[k]:=75;
for k:=68 to 69 do s[k]:=100;
end;
Procedure Nombre_a_trouver;
begin
randomize;
nb:=random (900)+100;
writeln('Le nombre trouver est ',nb,
' ,appuyez sur <ENTREE> pour avoir la solution');
readln;
end;
PROCEDURE tirage_des_six_plaquettes(s:sac);
var i,j:integer;
alea:integer;
appartient:boolean;
begin
randomize;
for j:=1 to 6 do p[j] := 0;
j:=1;
repeat
alea:=random (69)+1;
appartient:=false;
i:=1;
while (not(appartient)) and (i<>j) do
begin
if (alea=p[i]) then appartient:=true
else i:=i+1;
end;
if (not(appartient)) then
begin
p[j] := alea;
j := j+1;
end;
until (j=6);
write('Nombres tir?s : ');
for j:=1 to 6 do write(' | ',s[p[j]],' | ');
writeln;
end;
PROCEDURE calcul;
var i:integer;
begin
for i:=1 to 5 do
f[i]:=abs(nb-p[i]*p[i+1]);
for i:=1 to 4 do
f[i+5]:=abs(nb-p[i]*p[i+2]);
for i:=1 to 3 do
f[i+9]:=abs(nb-p[i]*p[i+3]);
for i:=1 to 2 do
f[i+12]:=abs(nb-p[i]*p[i+4]);
f[15]:=abs(nb-p[1]*p[6]);
if f[1]<f[2] then
min:=f[1] else min:=f[2];
for i:=3 to 15 do
begin
if f[i]<min then min:=f[i] else min:=min;
end;
end;
PROCEDURE minimum;
begin
if min=0 then writeln ('YAHOO ! Le compte est bon !');
end;
PROCEDURE elimination ;
var i:integer;
begin
if min=f[1] then for i:=1 to 4 do g[i]:=p[i+2];
if min=f[2] then
begin
g[1]:=p[1];
for i:=2 to 4 do g[i]:=p[i+2];
end;
if min=f[3] then
begin
for i:=1 to 2 do g[i]:=p[i];
for i:=3 to 4 do g[i]:=p[i+2];
end;
if min=p[4] then
begin
for i:=1 to 3 do g[i]:=p[i];
g[4]:=p[6];
end;
if min=f[5] then
for i:=1 to 4 do g[i]:=p[i];
if min=f[6] then
begin
g[1]:=p[2];
for i:=2 to 4 do g[i]:=p[i+2];
end;
if min=f[7] then
begin
g[1]:=p[1];
g[2]:=p[2];
for i:=3 to 4 do g[i]:=p[i+2];
end;
if min=f[8] then
begin
for i:=1 to 2 do g[i]:=p[i];
g[3]:=p[4];
g[4]:=p[6];
end;
if min=f[9] then
begin
for i:=1 to 3 do g[i]:=p[i];
g[4]:=p[5];
end;
if min=f[10] then
begin
for i:=1 to 2 do g[i]:=p[i+1];
for i:=3to 4 do g[i]:=p[i+2];
end;
if min=f[11] then
begin
g[1]:=p[1];
for i:= 2 to 3 do g[i]:=p[i+1];
g[4]:=p[6];
end;
if min=f[12] then
begin
for i:=1to 2 do g[i]:=p[i];
for i:= 3 to 4 do g[i]:=p[i+1];
end;
if min=f[13] then
begin
for i:=1to 3 do g[i]:=p[i+1];
g[4]:=p[6];
end;
if min=f[14] then
begin
g[1]:=p[1];
for i:=2 to 4 do g[i]:=p[i+1];
end;
if min=f[15] then
for i:=1 to 4 do g[i]:=p[i+1];
end;
PROCEDURE calcul2;
var i:integer;
begin
if min>0 then
begin
for i:=1 to 3 do
h[i]:=abs(min-(g[i]+g[i+1]));
for i:=1 to 2 do
h[i+3]:=abs(min-(g[i]+g[i+2]));
h[6]:=abs(min-(g[1]+g[4]));
for i:=1 to 3 do
h[i+6]:=abs(min-(g[i]*g[i+1]));
for i:=1 to 2 do
h[i+9]:=abs(min-(g[i]*g[i+2]));
h[12]:=abs(min-(g[1]*g[4]));
for i:=1to 3 do
h[i+12]:=abs(min-(g[i]-g[i+1]));
for i:=1 to 2 do
h[i+15]:=abs(min-(g[i]-g[i+2]));
h[18]:=abs(min-(g[1]-g[4]));
if h[1]<h[2] then
minus:=h[1] else minus:=h[2];
for i:=3 to 15 do
begin
if h[i]<minus then
minus:=h[i] else
minus:=minus;
end;
end;
end;
PROCEDURE minimal;
begin
if min>0 then
begin
if minus=0 then writeln ('YAHOO ! Le compte est bon !');
end;
end;
PROCEDURE elimination2;
var i:integer;
begin
for i:=0 to 3 do
begin if minus=h[1+6*i] then
begin
u:=g[3];
v:=g[4];
end;
end;
for i:=0 to 3 do
begin
if minus=h[2+6*i] then
begin
u:=g[1];
v:=g[4];
end;
end;
for i:=0 to 3 do
begin
if minus=h[3+6*i] then
begin
u:=g[1];
v:=g[2];
end;
end;
for i:=0 to 3 do
begin
if minus=h[4+6*i] then
begin
u:=g[2];
v:=g[4];
end;
end;
for i:=0 to 3 do
begin
if minus=h[5+6*i] then
begin
u:=g[1];
v:=g[3];
end;
end;
for i:=0 to 3 do
begin
if minus=h[6+6*i] then
begin
u:=g[2];
v:=g[3];
end;
end;
end;
PROCEDURE calcul3;
var i:integer;
begin
if min>0 then
begin
if min>0 then
begin
q[1]:=abs(minus-u*v);
q[2]:=abs(minus-(u+v));
q[3]:=abs(minus-(u-v));
q[4]:=abs(minus-(v-u));
if g[1]<g[2] then
micro:=g[1] else
micro:=g[2];
if g[3]<micro then
micro:=g[3] else
micro:=micro;
end;
end;
end;
PROCEDURE finale;
begin
if min>0 then
begin
if min>0 then
begin
while micro<0 do calcul3;
if micro=0 then
writeln ('YAHOO ! Le compte est bon !');
if micro>0 then
writeln ('Le nombre le plus proche est :
',nb-micro);
end;
end;
end;
var s1:sac;
var o:string[1];
begin
clrscr;
remplit_sac (s1);
tirage_des_six_plaquettes (s1);
nombre_a_trouver;
calcul;
minimum;
elimination;
calcul2;
minimal;
elimination2;
calcul3;
finale;
Writeln;
Writeln('Voulez-vous faire un autre compte ? (o/n)');
readln(o);
while o<>'n' do
begin
clrscr;
remplit_sac (s1);
tirage_des_six_plaquettes (s1);
nombre_a_trouver;
calcul;
minimum;
elimination;
calcul2;
minimal;
elimination2;
calcul3;
finale;
Writeln;
Writeln('Voulez-vous faire un autre compte ? (o/n)');
readln(o);
end;
if o='n' then writeln('Au revoir...');
readln;
end.
