Newsgroup: it.comp.lang.pascal
Titolo: Need help to improve a program in TP



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.


hey,
c'est la partie calcul de mon programme.
il est bien sur  possible de l'ameliorer ,au moins pour le rendre
"intelligent"
bye
patrick
marseille
p.s. ton random il me semble bizarre et de plus avec le "compte est bon
"normalement  des 1 par exemple, il ne peut y en avoir que 2 a la fois
p.s.2. desole , le formatage du texte n'est pas respecte ,pourquoi ???
unit  U_Compte;
interface
  const
    MAXNUM = 28;
  type
    TABA = array[0..27] of integer;
    TABB = array[0..5] of integer;
    TABC = array[0..719,0..5] of byte;
    TABD = array[0..4,0..2] of integer;
    TABE = array[0..4] of char;
  procedure  Tirnum(NumeroOn : boolean; var  alea, ordi : TABA);
  procedure  Combin(var  tira : TABB; var  comb : TABC);
  function   Oprcom(codo, num1, num2 : integer) : integer;
  function   Metho1(sini, nomb : integer;
      var  comb : TABC;
      var  snbr : integer;
      var  snum : TABD; var  sopr : TABE) : integer;
  function   Metho2(sini, nomb : integer;
      var  comb : TABC;
      var  snbr : integer;
      var  snum : TABD; var  sopr : TABE) : integer;
implementation
  procedure  Tirord(var  tira, ordi : TABA; numr : integer);
  var
    temp : integer;
    i, j, k : integer;
  begin
    i := numr div 2;
    while i > 0 do
    begin
      for j := i to numr - 1 do
      begin
k := j - i;
while k >= 0 do
begin
   if ( tira[k] <= tira[k + i] ) then
   begin
     temp := tira[k];
     tira[k] := tira[k + i];
     tira[k + i] := temp;
     if ( numr <> 6 ) then
     begin
       temp := ordi[k];
       ordi[k] := ordi[k + i];
       ordi[k + i] := temp;
     end;
   end;
   k := k - i;
end;
      end;
      i := i div 2;
    end;
  end;
  procedure  Tirnum(NumeroOn : boolean; var alea, ordi : TABA);
  const
    tabl : TABA =
    (   1,   2,   3,   4,   5,   6,   7,
        8,   9,  10,  25,  50,  75, 100,
        1,   2,   3,   4,   5,   6,   7,
        8,   9,  10,  25,  50,  75, 100 );
  var
    numr : integer;
    i : integer;
  begin
    randomize;
    if ( NumeroOn ) then
    begin
      for i := 0 to MAXNUM - 1 do
   alea[i] := tabl[i];
    end
    else
    begin
      numr := MAXNUM;
      for i := 0 to MAXNUM - 1 do
   alea[i] := random(255);
      tirord(alea, ordi, numr);
      for i := 0 to MAXNUM - 1 do
   alea[i] := tabl[ordi[i]];
    end;
  end;
  procedure  Combin(var tira : TABB; var comb : TABC);
  var
    ncom, i1, i2, i3, i4, i5, i6 : integer;
  begin
    ncom := 0;
    for i1 := 1 to 6 do
    begin
      for i2 := 1 to 6 do
      begin
if ( i2 <> i1 ) then
begin
   for i3 := 1 to 6 do
   begin
    if ( (i3 <> i2) and (i3 <> i1) ) then
    begin
      for i4 := 1 to 6 do
      begin
        if ( (i4 <> i3) and (i4 <> i2) and (i4 <> i1) ) then
        begin
   for i5 := 1 to 6 do
   begin
     if ( (i5 <> i4) and (i5 <> i3) and
   (i5 <> i2) and (i5 <> i1) ) then
     begin
       for i6 := 1 to 6 do
       begin
         if ( (i6 <> i5) and (i6 <> i4) and
       (i6 <> i3) and (i6 <> i2) and
       (i6 <> i1) ) then
         begin
    ncom := ncom + 1;
    comb[ncom-1][0] := tira[i1-1];
    comb[ncom-1][1] := tira[i2-1];
    comb[ncom-1][2] := tira[i3-1];
    comb[ncom-1][3] := tira[i4-1];
    comb[ncom-1][4] := tira[i5-1];
    comb[ncom-1][5] := tira[i6-1];
         end;
       end;
     end;
   end;
        end;
      end;
    end;
  end;
       end;
     end;
    end;
  end;
  function  Additi(num1, num2 : integer) : integer;
  begin
    Additi := num1 + num2;
  end;
  function  Substr(num1, num2 : integer) : integer;
  begin
    Substr := num1 - num2;
  end;
  function  Multip(num1, num2 : integer) : integer;
  var
    mult : integer;
  begin
    mult := num1 * num2;
    if ( ((num1 = 1) or (num2 = 1)) or (mult > 1500) ) then
  mult := -1;
    Multip := mult;
  end;
  function  Divide(num1, num2 : integer) : integer;
  var
    divi : integer;
  begin
    divi := -1;
    if ( (num2 > 1) and (( num1 mod num2 ) = 0 ) ) then
  divi := num1 div num2;
    Divide := divi;
  end;
  function  Oprcom(codo, num1, num2 : integer) : integer;
  begin
    case codo of
      0 : Oprcom := Additi(num1, num2);
      1 : Oprcom := Substr(num1, num2);
      2 : Oprcom := Multip(num1, num2);
      3 : Oprcom := Divide(num1, num2);
    end;
  end;
  function  Metho1(sini, nomb : integer;
     var  comb : TABC;
     var  snbr : integer;
     var  snum : TABD; var  sopr : TABE) : integer;
  const
    oper : array[0..3] of char = ('+','-','*','/');
  var
    num1, num2, num3, num4, num5, num6 : integer;
    opr1, opr2, opr3, opr4, opr5 : integer;
    sval : integer;
    i, j, k, l, m, n : integer;
  begin
    sval := sini;
    for i := 0 to 719 do
    begin
      num1 := comb[i][0];
      num2 := comb[i][1];
      num3 := comb[i][2];
      num4 := comb[i][3];
      num5 := comb[i][4];
      num6 := comb[i][5];
      opr1 := 0;
      opr2 := 0;
      opr3 := 0;
      opr4 := 0;
      opr5 := 0;
      for j := 0 to 3 do
      begin
opr1 := oprcom(j, num1, num2);
if ( opr1 > 0 ) then
begin
   if ( abs(nomb - opr1) < abs(nomb - sval) ) then
   begin
     snbr := 1;
     snum[0][0] := num1;
     snum[0][1] := num2;
     snum[0][2] := opr1;
     sopr[0] := oper[j];
     sval := opr1;
     if ( opr1 = nomb ) then
     begin
       Metho1 := sval;
       exit;
     end;
   end;
   for k := 0 to 3 do
   begin
     opr2 := oprcom(k, opr1, num3);
     if ( opr2 > 0 ) then
     begin
       if ( abs(nomb - opr2) < abs(nomb - sval) ) then
       begin
  snbr := 2;
  snum[0][0] := num1;
  snum[0][1] := num2;
  snum[0][2] := opr1;
  sopr[0] := oper[j];
  snum[1][0] := opr1;
  snum[1][1] := num3;
  snum[1][2] := opr2;
  sopr[1] := oper[k];
  sval := opr2;
  if ( opr2 = nomb ) then
  begin
    Metho1 := sval;
    exit;
  end;
       end;
       for l := 0 to 3 do
       begin
  opr3 := oprcom(l, opr2, num4);
  if ( opr3 > 0 ) then
  begin
    if ( abs(nomb - opr3) < abs(nomb - sval) ) then
    begin
      snbr := 3;
      snum[0][0] := num1;
      snum[0][1] := num2;
      snum[0][2] := opr1;
      sopr[0] := oper[j];
      snum[1][0] := opr1;
      snum[1][1] := num3;
      snum[1][2] := opr2;
      sopr[1] := oper[k];
      snum[2][0] := opr2;
      snum[2][1] := num4;
      snum[2][2] := opr3;
      sopr[2] := oper[l];
      sval := opr3;
      if ( opr3 = nomb ) then
      begin
        Metho1 := sval;
        exit;
      end;
    end;
    for m := 0 to 3 do
    begin
      opr4 := oprcom(m, opr3, num5);
      if ( opr4 > 0 ) then
      begin
        if ( abs(nomb - opr4) < abs(nomb - sval) ) then
        begin
   snbr := 4;
   snum[0][0] := num1;
   snum[0][1] := num2;
   snum[0][2] := opr1;
   sopr[0] := oper[j];
   snum[1][0] := opr1;
   snum[1][1] := num3;
   snum[1][2] := opr2;
   sopr[1] := oper[k];
   snum[2][0] := opr2;
   snum[2][1] := num4;
   snum[2][2] := opr3;
   sopr[2] := oper[l];
   snum[3][0] := opr3;
   snum[3][1] := num5;
   snum[3][2] := opr4;
   sopr[3] := oper[m];
   sval := opr4;
   if ( opr4 = nomb ) then
   begin
     Metho1 := sval;
     exit;
   end;
        end;
        for n := 0 to 3 do
        begin
   opr5 := oprcom(n, opr4, num6);
   if ( opr5 > 0 ) then
   begin
     if ( abs(nomb - opr5) < abs(nomb - sval) ) then
     begin
       snbr := 5;
       snum[0][0] := num1;
       snum[0][1] := num2;
       snum[0][2] := opr1;
       sopr[0] := oper[j];
       snum[1][0] := opr1;
       snum[1][1] := num3;
       snum[1][2] := opr2;
       sopr[1] := oper[k];
       snum[2][0] := opr2;
       snum[2][1] := num4;
       snum[2][2] := opr3;
       sopr[2] := oper[l];
       snum[3][0] := opr3;
       snum[3][1] := num5;
       snum[3][2] := opr4;
       sopr[3] := oper[m];
       snum[4][0] := opr4;
       snum[4][1] := num6;
       snum[4][2] := opr5;
       sopr[4] := oper[n];
       sval := opr5;
       if ( opr5 = nomb ) then
       begin
         Metho1 := sval;
         exit;
       end;
     end;
   end;
        end;
     end;
    end;
  end;
       end;
     end;
   end;
end;
      end;
    end;
    Metho1 := sval;
  end;
  function  Metho2(sini, nomb : integer;
     var  comb : TABC;
     var  snbr : integer;
     var  snum : TABD; var  sopr : TABE) : integer;
  const
    oper : array[0..3] of char = ('+','-','*','/');
  var
    num1, num2, num3, num4, num5, num6 : integer;
    opr1, opr2, opr3, opr4, opr5 : integer;
    sval : integer;
    i, j, k, l, m, n : integer;
  begin
    sval := sini;
    for i := 0 to 719 do
    begin
      num1 := comb[i][0];
      num2 := comb[i][1];
      num3 := comb[i][2];
      num4 := comb[i][3];
      num5 := comb[i][4];
      num6 := comb[i][5];
      opr1 := 0;
      opr2 := 0;
      opr3 := 0;
      opr4 := 0;
      opr5 := 0;
      for j := 0 to 3 do
      begin
opr1 := oprcom(j, num1, num2);
if ( opr1 > 0 ) then
begin
   for k := 0 to 3 do
   begin
     opr2 := oprcom(k, num3, num4);
     if ( opr2 > 0 ) then
     begin
       for l := 0 to 3 do
       begin
  opr3 := oprcom(l, opr1, opr2);
  if ( opr3 > 0 ) then
  begin
    if ( abs(nomb - opr3) < abs(nomb - sval) ) then
    begin
      snbr := 3;
      snum[0][0] := num1;
      snum[0][1] := num2;
      snum[0][2] := opr1;
      sopr[0] := oper[j];
      snum[1][0] := num3;
      snum[1][1] := num4;
      snum[1][2] := opr2;
      sopr[1] := oper[k];
      snum[2][0] := opr1;
      snum[2][1] := opr2;
      snum[2][2] := opr3;
      sopr[2] := oper[l];
      sval := opr3;
      if ( opr3 = nomb ) then
      begin
        Metho2 := sval;
        exit;
      end;
    end;
    for m := 0 to 3 do
    begin
      opr4 := oprcom(m, opr3, num5);
      if ( opr4 > 0 ) then
      begin
        if ( abs(nomb - opr4) < abs(nomb - sval) ) then
        begin
   snbr := 4;
   snum[0][0] := num1;
   snum[0][1] := num2;
   snum[0][2] := opr1;
   sopr[0] := oper[j];
   snum[1][0] := num3;
   snum[1][1] := num4;
   snum[1][2] := opr2;
   sopr[1] := oper[k];
   snum[2][0] := opr1;
   snum[2][1] := opr2;
   snum[2][2] := opr3;
   sopr[2] := oper[l];
   snum[3][0] := opr3;
   snum[3][1] := num5;
   snum[3][2] := opr4;
   sopr[3] := oper[m];
   sval := opr4;
   if ( opr4 = nomb ) then
   begin
     Metho2 := sval;
     exit;
   end;
        end;
        for n := 0 to 3 do
        begin
   opr5 := oprcom(n, opr4, num6);
   if ( opr5 > 0 ) then
   begin
     if ( abs(nomb - opr5) < abs(nomb - sval) ) then
     begin
       snbr := 5;
       snum[0][0] := num1;
       snum[0][1] := num2;
       snum[0][2] := opr1;
       sopr[0] := oper[j];
       snum[1][0] := num3;
       snum[1][1] := num4;
       snum[1][2] := opr2;
       sopr[1] := oper[k];
       snum[2][0] := opr1;
       snum[2][1] := opr2;
       snum[2][2] := opr3;
       sopr[2] := oper[l];
       snum[3][0] := opr3;
       snum[3][1] := num5;
       snum[3][2] := opr4;
       sopr[3] := oper[m];
       snum[4][0] := opr4;
       snum[4][1] := num6;
       snum[4][2] := opr5;
       sopr[4] := oper[n];
       sval := opr5;
       if ( opr5 = nomb ) then
       begin
         Metho2 := sval;
         exit;
       end;
     end;
   end;
        end;
      end;
    end;
    for m := 0 to 3 do
    begin
      opr4 := oprcom(m, num5, num6);
      if ( opr4 > 0 ) then
      begin
        for n := 0 to 3 do
        begin
   opr5 := oprcom(n, opr3, opr4);
   if ( opr5 > 0 ) then
   begin
     if ( abs(nomb - opr5) < abs(nomb - sval) ) then
     begin
       snbr := 5;
       snum[0][0] := num1;
       snum[0][1] := num2;
       snum[0][2] := opr1;
       sopr[0] := oper[j];
       snum[1][0] := num3;
       snum[1][1] := num4;
       snum[1][2] := opr2;
       sopr[1] := oper[k];
       snum[2][0] := opr1;
       snum[2][1] := opr2;
       snum[2][2] := opr3;
       sopr[2] := oper[l];
       snum[3][0] := num5;
       snum[3][1] := num6;
       snum[3][2] := opr4;
       sopr[3] := oper[m];
       snum[4][0] := opr3;
       snum[4][1] := opr4;
       snum[4][2] := opr5;
       sopr[4] := oper[n];
       sval := opr5;
       if ( opr5 = nomb ) then
       begin
         Metho2 := sval;
         exit;
       end;
     end;
   end;
        end;
      end;
    end;
  end;
       end;
     end;
   end;
end;
      end;
    end;
    Metho2 := sval;
  end;
end.



This is a Polish group.