Article View: comp.lang.pascal.ansi-iso
Article #36Need help to improve a program in TP
From: Gab
Date: Thu, 04 Mar 1999 00:00
Date: Thu, 04 Mar 1999 00:00
823 lines
28206 bytes
28206 bytes
--------------D341E91A853059C3FDEA3A5F
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
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.
--------------D341E91A853059C3FDEA3A5F
Content-Type: text/html; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<center><font size=+2>Hello everybody!</font></center>
<p> I need your help to improve the calcul method
of a program.
<br>This program is called "le compte est bon" and consist in making the
computer
<br>calculate a given random number with six other numbers
("plaquettes") and
<br>the operations {*, /,+, -}. It uses each of the six numbers only once
and if it do
<br>not find, gives the best approximation.
<br>I've already done something, but the program is not "intelligent" enough.
<br> So, if you have ideas, put your modifications in
an other color in the source
<br>and send it back, thank you!
<p>Here's the source code:
<p>PROGRAM Le_compte_est_bon;
<p>uses crt;
<p>type table=array [100..999] of integer;
<p>type sac=array [1..69] of integer;
<p>type position=array[1..6] of integer;
<br>var p:position;
<p>type fableau=array[1..15] of integer;
<br>var f:fableau;
<p>type gableau=array[1..4] of integer;
<br>var g:gableau;
<p>type hableau=array[1..18] of integer;
<br>var h:hableau;
<p>type qableau=array[1..4] of integer;
<br>var q:qableau;
<p>var nb,min,minus,micro,u,v:integer;
<br>
<p>Procedure remplit_sac (var s:sac);
<br>var k:integer;
<br>begin
<br> for k:=1 to 10 do s[k]:=1;
<br> for k:=11 to 20 do s[k]:=2;
<br> for k:=21 to 25 do s[k]:=3;
<br> for k:=26 to 30 do s[k]:=4;
<br> for k:=31 to 35 do s[k]:=5;
<br> for k:=36 to 40 do s[k]:=6;
<br> for k:=41 to 45 do s[k]:=7;
<br> for k:=46 to 50 do s[k]:=8;
<br> for k:=51 to 55 do s[k]:=9;
<br> for k:=56 to 59 do s[k]:=10;
<br> for k:=60 to 62 do s[k]:=25;
<br> for k:=63 to 65 do s[k]:=50;
<br> for k:=66 to 67 do s[k]:=75;
<br> for k:=68 to 69 do s[k]:=100;
<br>end;
<p>Procedure Nombre_a_trouver;
<br>begin
<br> randomize;
<br> nb:=random (900)+100;
<br> writeln('Le nombre � trouver est ',nb,
<br>
' ,appuyez sur <ENTREE> pour avoir la solution');
<br> readln;
<br>end;
<br>
<p>PROCEDURE tirage_des_six_plaquettes(s:sac);
<br>var i,j:integer;
<br> alea:integer;
<br> appartient:boolean;
<p>begin
<br>randomize;
<br>for j:=1 to 6 do p[j] := 0;
<br>j:=1;
<p>repeat
<br> alea:=random (69)+1;
<br> appartient:=false;
<br> i:=1;
<br> while (not(appartient)) and (i<>j)
do
<br>
begin
<br>
if (alea=p[i]) then appartient:=true
<br>
else i:=i+1;
<br>
end;
<p> if (not(appartient)) then
<br> begin
<br>
p[j] := alea;
<br>
j := j+1;
<br> end;
<br>until (j=6);
<p>write('Nombres tir�s : ');
<br>for j:=1 to 6 do write(' | ',s[p[j]],' | ');
<br>writeln;
<br>end;
<br>
<p>PROCEDURE calcul;
<br>var i:integer;
<p>begin
<br>for i:=1 to 5 do
<br> f[i]:=abs(nb-p[i]*p[i+1]);
<br>for i:=1 to 4 do
<br> f[i+5]:=abs(nb-p[i]*p[i+2]);
<br>for i:=1 to 3 do
<br> f[i+9]:=abs(nb-p[i]*p[i+3]);
<br>for i:=1 to 2 do
<br> f[i+12]:=abs(nb-p[i]*p[i+4]);
<br>f[15]:=abs(nb-p[1]*p[6]);
<br>if f[1]<f[2] then
<br> min:=f[1] else min:=f[2];
<br>for i:=3 to 15 do
<br> begin
<br> if f[i]<min then
min:=f[i] else min:=min;
<br> end;
<br>end;
<br>
<p>PROCEDURE minimum;
<br>begin
<br> if min=0 then writeln ('YAHOO ! Le compte
est bon !');
<br>end;
<p>PROCEDURE elimination ;
<br>var i:integer;
<p>begin
<br>if min=f[1] then for i:=1 to 4 do g[i]:=p[i+2];
<br>if min=f[2] then
<br> begin
<br> g[1]:=p[1];
<br> for i:=2 to 4 do g[i]:=p[i+2];
<br> end;
<br>if min=f[3] then
<br> begin
<br> for i:=1 to 2 do g[i]:=p[i];
<br> for i:=3 to 4 do g[i]:=p[i+2];
<br> end;
<br>if min=p[4] then
<br> begin
<br> for i:=1 to 3 do g[i]:=p[i];
<br> g[4]:=p[6];
<br> end;
<br>if min=f[5] then
<br> for i:=1 to 4 do g[i]:=p[i];
<br>if min=f[6] then
<br> begin
<br> g[1]:=p[2];
<br> for i:=2 to 4 do g[i]:=p[i+2];
<br> end;
<br>if min=f[7] then
<br> begin
<br> g[1]:=p[1];
<br> g[2]:=p[2];
<br> for i:=3 to 4 do g[i]:=p[i+2];
<br> end;
<br>if min=f[8] then
<br> begin
<br> for i:=1 to 2 do g[i]:=p[i];
<br> g[3]:=p[4];
<br> g[4]:=p[6];
<br> end;
<br>if min=f[9] then
<br> begin
<br> for i:=1 to 3 do g[i]:=p[i];
<br> g[4]:=p[5];
<br> end;
<br>if min=f[10] then
<br> begin
<br> for i:=1 to 2 do g[i]:=p[i+1];
<br> for i:=3to 4 do g[i]:=p[i+2];
<br> end;
<br>if min=f[11] then
<br> begin
<br> g[1]:=p[1];
<br> for i:= 2 to 3 do g[i]:=p[i+1];
<br> g[4]:=p[6];
<br> end;
<br>if min=f[12] then
<br> begin
<br> for i:=1to 2 do g[i]:=p[i];
<br> for i:= 3 to 4 do g[i]:=p[i+1];
<br> end;
<br>if min=f[13] then
<br> begin
<br> for i:=1to 3 do g[i]:=p[i+1];
<br> g[4]:=p[6];
<br> end;
<br>if min=f[14] then
<br> begin
<br> g[1]:=p[1];
<br> for i:=2 to 4 do g[i]:=p[i+1];
<br> end;
<br>if min=f[15] then
<br> for i:=1 to 4 do g[i]:=p[i+1];
<p>end;
<br>
<p>PROCEDURE calcul2;
<br>var i:integer;
<p>begin
<br>if min>0 then
<br> begin
<br> for i:=1 to 3 do
<br>
h[i]:=abs(min-(g[i]+g[i+1]));
<br> for i:=1 to 2 do
<br>
h[i+3]:=abs(min-(g[i]+g[i+2]));
<br> h[6]:=abs(min-(g[1]+g[4]));
<br> for i:=1 to 3 do
<br>
h[i+6]:=abs(min-(g[i]*g[i+1]));
<br> for i:=1 to 2 do
<br>
h[i+9]:=abs(min-(g[i]*g[i+2]));
<br> h[12]:=abs(min-(g[1]*g[4]));
<br> for i:=1to 3 do
<br>
h[i+12]:=abs(min-(g[i]-g[i+1]));
<br> for i:=1 to 2 do
<br>
h[i+15]:=abs(min-(g[i]-g[i+2]));
<br> h[18]:=abs(min-(g[1]-g[4]));
<br> if h[1]<h[2] then
<br> minus:=h[1]
else minus:=h[2];
<br> for i:=3 to 15 do
<br>
begin
<br>
if h[i]<minus then
<br>
minus:=h[i] else
<br>
minus:=minus;
<br>
end;
<br> end;
<br>end;
<p>PROCEDURE minimal;
<br>begin
<p>if min>0 then
<br> begin
<br> if minus=0 then writeln
('YAHOO ! Le compte est bon !');
<br> end;
<br>end;
<p>PROCEDURE elimination2;
<br>var i:integer;
<p>begin
<br>for i:=0 to 3 do
<br> begin if minus=h[1+6*i] then
<br> begin
<br>
u:=g[3];
<br>
v:=g[4];
<br> end;
<br> end;
<br>for i:=0 to 3 do
<br> begin
<br> if minus=h[2+6*i]
then
<br>
begin
<br>
u:=g[1];
<br>
v:=g[4];
<br>
end;
<br> end;
<br>for i:=0 to 3 do
<br> begin
<br> if minus=h[3+6*i]
then
<br>
begin
<br>
u:=g[1];
<br>
v:=g[2];
<br>
end;
<br> end;
<br>for i:=0 to 3 do
<br>begin
<br> if minus=h[4+6*i] then
<br> begin
<br>
u:=g[2];
<br>
v:=g[4];
<br> end;
<br>end;
<br>for i:=0 to 3 do
<br> begin
<br> if minus=h[5+6*i]
then
<br>
begin
<br>
u:=g[1];
<br>
v:=g[3];
<br>
end;
<br> end;
<br>for i:=0 to 3 do
<br> begin
<br> if minus=h[6+6*i]
then
<br>
begin
<br>
u:=g[2];
<br>
v:=g[3];
<br>
end;
<br> end;
<br>end;
<p>PROCEDURE calcul3;
<br>var i:integer;
<p>begin
<br>if min>0 then
<br> begin
<br> if min>0 then
<br> begin
<br>
q[1]:=abs(minus-u*v);
<br>
q[2]:=abs(minus-(u+v));
<br>
q[3]:=abs(minus-(u-v));
<br>
q[4]:=abs(minus-(v-u));
<br>
if g[1]<g[2] then
<br>
micro:=g[1] else
<br>
micro:=g[2];
<br>
if g[3]<micro then
<br>
micro:=g[3] else
<br>
micro:=micro;
<br> end;
<br> end;
<br>end;
<p>PROCEDURE finale;
<br>begin
<br> if min>0 then
<br> begin
<br>
if min>0 then
<br>
begin
<br>
while micro<0 do calcul3;
<br>
if micro=0 then
<br>
writeln ('YAHOO ! Le compte est bon !');
<br>
if micro>0 then
<br>
writeln ('Le nombre le plus proche est : ',nb-micro);
<br>
end;
<br> end;
<br>end;
<p>var s1:sac;
<br>var o:string[1];
<p>begin
<br> clrscr;
<br> remplit_sac (s1);
<br> tirage_des_six_plaquettes (s1);
<br> nombre_a_trouver;
<br> calcul;
<br> minimum;
<br> elimination;
<br> calcul2;
<br> minimal;
<br> elimination2;
<br> calcul3;
<br> finale;
<br> Writeln;
<br> Writeln('Voulez-vous faire un autre compte
? (o/n)');
<br> readln(o);
<br> while o<>'n' do
<br> begin
<br>
clrscr;
<br>
remplit_sac (s1);
<br>
tirage_des_six_plaquettes (s1);
<br>
nombre_a_trouver;
<br>
calcul;
<br>
minimum;
<br>
elimination;
<br>
calcul2;
<br>
minimal;
<br>
elimination2;
<br>
calcul3;
<br>
finale;
<br>
Writeln;
<br>
Writeln('Voulez-vous faire un autre compte ? (o/n)');
<br>
readln(o);
<br> end;
<br> if o='n' then writeln('Au revoir...');
<br> readln;
<p>end.</html>
--------------D341E91A853059C3FDEA3A5F--
Technical Details
Message-ID:
<36DEAA7D.E1801780@caramail.com>Path:
arc1-ca.pugleaf.net!unknown!not-for-mailShow Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII X-Google-Thread: 110467,6b644f28240805ed,start X-Google-Attributes: gid110467,public X-Google-Thread: 10c950,6b644f28240805ed,start X-Google-Attributes: gid10c950,public From: Gab <Gab25@caramail.com> Subject: Need help to improve a program in TP Date: 1999/03/04 Message-ID: <36DEAA7D.E1801780@caramail.com> X-Deja-AN: 451190737 X-Accept-Language: fr Content-Type: multipart/alternative; boundary="------------D341E91A853059C3FDEA3A5F" X-Trace: front7.grolier.fr 920562286 9969 195.36.198.36 (4 Mar 1999 15:44:46 GMT) Organization: Club-Internet (France) Mime-Version: 1.0 NNTP-Posting-Date: 4 Mar 1999 15:44:46 GMT Newsgroups: comp.lang.pascal.ansi-iso,fido.ger.pascal