Discussion :

[aaa98]

J'étais en train d'exécuter ce programme là en lazarus , pour la compilation il est bien vérifié , mais j'arrive pas a identifier l'erreur

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Program Rigolo ;
Uses WinCrt , Crt ;
Var f : text ; n,m : integer ;
Procedure saisie ( var n , m : integer );
 Begin
   Repeat
     Write ('M = '); Readln (m) ;
   Until m > 100 ;
   Repeat
     Write ('N = '); Readln (n) ;
   Until (n > m) and (n < 1000)
 End;
Function somchif ( x : integer ) : integer ;
 Var ch : string ; nb , i : integer ;
   Begin
     Str (x,ch) ;
     nb := 0 ;
     For i := 1 to length(ch) Do
       nb := nb + (Ord ( ch[i] ) - 48) ;
     somchif :=  nb ;
   end;
Function fp ( x : integer ) : string ;
 Var i : integer ; ch , chi : string ;
   Begin
     i := 2 ;
     ch := '' ;
     Repeat
       If (x Mod i ) = 0 then
         Begin
           str (i,chi) ;
           ch := ch + chi + '*' ;
           x := x Div i ;
         End;
       i := i + 1 ;
     Until n = 1 ;
     fp := copy (ch,1,length(ch)-1) ;
   End;
Procedure remplir ( var f : text ; n , m : integer ) ;
 Var ch : string ; i , j , nb , sfp : integer ;
   Begin
     Rewrite (f) ;
     For i := m to n Do
       Begin
         nb := i ;
         sfp := 0 ;
         j := 2 ;
         Repeat
           If (( nb Mod j ) = 0) then
             Begin
               sfp := sfp + somchif (j) ;
               nb := n Div j ;
             end;
           j := j + 1 ;
         until nb = 1 ;
         If (somchif(i) = sfp) then
           Begin
             Str (i,ch) ;
             Writeln (f,ch+' = '+fp(i));
           end;
       end;
     End;
Procedure afficher ( var f : text ) ;
 Var ch : string ; ok : boolean ;
   Begin
     Reset (f) ;
     ok := false ;
         While not ( eof (f)) Do
           Begin
             Readln (f,ch) ;
             Writeln (ch) ;
             ok := true ;
           End;
     If not (ok) then Writeln ('Aucun nombre rigolo');
   End;
Begin
  Assign (f,'S:\fich\Resultats.Txt');
  saisie (n,m) ;
  remplir (f,n,m) ;
  afficher (f) ;
  Readln;
End.

Merci de m'aider

[gvasseur58]

J'étais en train d'exécuter ce programme là en lazarus , pour la compilation il est bien vérifié , mais j'arrive pas a identifier l'erreur

Problème - entre autres ? - dans cette fonction :

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
 
Function fp ( x : integer ) : string ;
 Var i : integer ; ch , chi : string ;
   Begin
     i := 2 ;
     ch := '' ;
     Repeat
       If (x Mod i ) = 0 then
         Begin
           str (i,chi) ;
           ch := ch + chi + '*' ;
           x := x Div i ;
         End;
       i := i + 1 ;
     Until n = 1 ; // <==== ?????
     fp := copy (ch,1,length(ch)-1) ;
   End;

Bonjour,

Pour t'aider, il faudrait décrire le problème rencontré, non ? De plus, si tu veux t'en sortir, il faudrait aussi soigner tes codes source, car ils sont difficilement lisibles.
Cela dit, je vois une erreur immédiate dans ta fonction fp : la boucle repeat ne peut jamais s'arrêter car n ne varie jamais : comment pourrait-il être égal à 1 ?

Exemple de fonction plus lisible, car cohérente dans son affichage et documentée :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
function somchif(x: Integer): Integer;
// *** calcul de la somme des chiffres d'un entier ***
var
  ch: string;
  i: Integer;
begin
  Str (x,ch);
  somchif := 0;
  for i := 1 to Length(ch) do
    somchif := somchif + (Ord(Ch[i]) - 48);
end;

Je n'ai pas eu le temps de tester le reste, mais ça va venir si quelqu'un n'est pas plus rapide que moi
Cordialement,

Gilles

[aaa98]

Oui dès que j'ai fixé ce problème de (n) , une autre erreur est apparut , dans tt les cas merci bcp et désolé j'ai pas mis l'enoncé du programme...

[anapurna]

salut

ta décomposition en nombre premier me parait hasardeuse
1°) écrire des noms de variable parlant
2°)utiliser un repeat oblige a passer au moins une fois dans la boucle si ton nombre est 1 .. tu devrais pouvoir sortir sans faire de boucle

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
 Function DecompositionFacteurPremier ( Nombre : integer ) : string ;
 Var 
     Diviseur : integer ;
     StrDiv , StrFi : string ;
   Begin
     Diviseur := 2 ;
     StrFi := '' ;
     // Repeat   // on rentre dedans  sans verifier 
     While Nombre <> 1 do  
     Begin
        If (Nombre Mod Diviseur ) = 0 then
         Begin
            str (Diviseur,StrDiv) ;
            StrFi := StrFi + StrDiv + '*' ;
            Nombre := Nombre Div Diviseur ;
         End
         else  // seulement si tu ne peut plus diviser par le diviseur tu passe au suivant
            Diviseur := Diviseur + 1 ;
     End;
     //Until Nombre = 1 ; // <==== ????? // je suppose que c'est une erreur de transcription
     DecompositionFacteurPremier := copy (StrFi,1,length(StrFi)-1) ; 
 End;

ta fonction remplir est un peu imcomprehensible

tu veut pour tout le chiffre de m a n
calculer la somme des facteur et la somme du chiffre

donc ce if dans ta boucle devrais suffire

Code :

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

1
2
3
 
     if SommeChiffre(Strtoint(DecompositionFacteurPremier (I))) = SommeChiffre(I)  Then    
             Writeln (f,IntToStr(i)+' = '+DecompositionFacteurPremier(i));

bon je pousse pas plus loin

[aaa98]

Je vous remercie bien