Discussion :

[Haythem02]

Bonjour tout le monde
Il y'a un problème j'ai pas pu le résoudre donc Svp si vous pouvez m'aider voici le problème :
Écrire un programme qui permet de déterminer un nombre composé de 4 chiffre abcd tel que abc+dab+cda+bcd=abcd .
Je croit qu'il faut utiliser la boucle ' pour '
Si c'est possible avec 2 méthode
Merci.

[Dr.Who]

le choix de boucle est determiner par les besoins et contraintes.

for, while, repeat ou même label+goto.

ici, je ne vois pas de besoins de boucle.

j'ai 4 chiffre A, B, C, D

j'ai besoin d'un compositeur de nombre qui assemble 3 des 4 en un nombre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
function Compositor3(const c100, c10, c1 : byte): integer;
var V : integer;
begin
  V := c100 * 100 + c10 * 10 + c1;
  compositor3 := V;
end;

finalement, il me faut une fonction pour composer ABCD :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
function Compositor4(const A, B, C, D: byte): integer;
var V : integer;
begin
  // abc+dab+cda+bcd
  V := 
    Compositor3(A,B,C) +
    Compositor3(D,A,B) +
    Compositor3(C,D,A) +
    Compositor3(B,C,D);
 
  Compositor4 := V;
end;

et pour recuperer A,B,C,D :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
procedure ReadElement(var C: byte);
var r: char;
begin
  repeat
    read(r);
  until r in ['0'..'9'];
  C := byte(r) - $30;
end;
 
var
  A,B,C,D : byte;
begin
  ReadElement(A);  
  ReadElement(B);  
  ReadElement(C);  
  ReadElement(D);
  Writeln('');
  Writeln('Le resultat est : ', Compositor4(A,B,C,D));
end;

(codé de tête)

[Dr.Who]

ah pardon j'ai mal compris ta question en fait.

si j'ai bien compris donc :

j'ai un nombre 1234
et le programme doit determiner si ce nombre est bien egal à :

1234 ?= 123 + 412 + 341 + 234

c'est bien ça ?

alors pour ce faire, une fonction de test :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
function Compositor3(const c100, c10, c1 : byte): integer;
var V : integer;
begin
  V := c100 * 100 + c10 * 10 + c1;
  compositor3 := V;
end;
 
function IsSummable(const I: integer): boolean;
var A,B,C,D : byte;
  V : integer; 
  R : boolean;
begin
  V := 0;
  R := False;
 
  if I <= 9999 then
  begin
    D := I mod 10;
    C := (I div 10) mod 10;
    B := (I div 100) mod 10;
    A := (I div 1000) mod 10;
 
    V := 
      Compositor3(A,B,C) +
      Compositor3(D,A,B) +
      Compositor3(C,D,A) +
      Compositor3(B,C,D);
 
    R := I = V;
  end;
 
  IsSummable := R;
end;

ensuite pour trouver tout les nombres qui ont cette particularité :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
procedure GetAll;
var N : integer;
begin
  for N := 0 to 9999 do
  begin
    if IsSummable(N) then
      WriteLn(N);
  end;
end;

ici on test tout les nombres de 0 à 9999.

[Dr.Who]

on pourrait aussi faire (plus performant) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
procedure GetAll(const I: integer);
var V, A, B, C, D, A100, B100, C100, D100, A10, B10, C10, D10 : integer;
begin
  A := 0; A100 := 0; A10 := 0;
  B := 0; B100 := 0; B10 := 0;
  C := 0; C100 := 0; C10 := 0;
  D := 0; D100 := 0; D10 := 0;
 
  repeat
    V := (A100 + B10 + C) + (D100 + A10 + B) + (C100 + D10 + A) + (B100 + C10 + D);
 
    if I = V then
      WriteLn(V);
 
    D := (D + 1) mod 10;
      D100 := D*100;
      D10 := D*10;
    if D = 0 then
    begin
      C := (C + 1) mod 10;
        C100 := C*100;
        C10 := C*10;
      if C = 0 then
      begin
        B := (B + 1) mod 10;
          B100 := B*100;
          B10 := B*10;
        if B = 0 then
        begin
          A := A + 1;
            A100 := A*100;
            A10 := A*10;
        end; 
      end;
    end;
  until (A >= 10);
end;

[abdelhay2]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
uses wincrt;
 var
 ch1,ch2,ch3,ch4,ch:string;
 j,x1,x2,x3,x4,e1,e2,e3,e4,n,i:integer;
 
 begin
 n:=1000;
 repeat
  n:=n+1;
  i:=1;
 str(n,ch);
 repeat
   if i=1 then
   begin
    ch1:=copy(ch,1,3);
    i:=i+3;
   end;
 
 
      if i=3 then
   begin
    ch3:=copy(ch,i,2)+ch[1];
    i:=i-1;
   end;
      if i=4 then
   begin
    ch4:=ch[4]+copy(ch,1,2);
    i:=i-1;
   end;
    if i=2 then
   begin
    ch2:=copy(ch,i,3);
   end;
 until i=2;
 val(ch1,x1,e1); val(ch2,x2,e2);val(ch3,x3,e3);val(ch4,x4,e4);
  if n=x1+x2+x3+x4 then
  writeln(n,' = ',x1,' + ',x4,' + ',x3,' + ',x2);
 until n=9999;
 write('  ok ');
  end.

[kingmoezhaj]

Bref voici la premiere methode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
program determiner;
uses wincrt;
var
i,a,b,c,d,s:integer;
 
begin
for i:=1000 to 9999 do
    begin
    a:=i div 1000;
    b:=i div 100 mod 10;
    c:=i div 10 mod  10;
    d:=i mod 10;
    s:=a*111+b*111+c*111+d*111;
    if(s=i)then write(i,'=',a*100+b*10+c,'+',d*100+a*10+b,'+',c*100+d*10+a,'+',b*100+c*10+d);
    end;
end.