Runtime Error 100

Version imprimable

1 pièce(s) jointe(s)

Runtime Error 100

Voici l'énoncé de l'exercice (en pièce jointe) :
Pièce jointe 241388
et voici mon code pour le solutionner (mais malheureusement je reçoit une erreur runtime 100 :'( )

Code:

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
 
program Suit_Min;
type
	suite = record
		Dep, Nb : integer;
    end;
    Tfichier1 = file of integer;
    Tfichier2 = file of suite;
var
	p : integer;
    F1 : Tfichier1;
    F2 : Tfichier2;
{ ********** La saisie de P ********** }
procedure taille (var p : integer);
    begin
        repeat 
            writeln ('Donnez la taille du fichier');
            readln(p);
        until p in [2..30];
    end;
{ ********** Le remplisage du fichier "Depart.dat" ********** }
procedure remplir (var F1 : Tfichier1 ; p : integer);
    var
        U0, i : integer;
    begin
        rewrite(F1);
        for i:=1 to p do
            begin
                repeat
                    writeln('Donnez le ',i,' eme entier compris entre 2 et 1000 : ');
                    readln(U0);
                until U0 in [2..1000];
                write(F1,U0);
            end;
    end;
{ ********** Calcul de la suite ********** }
function calcul (U : integer) : integer;
    var
        Up, nbr : integer;
    begin
        nbr := 1;
        repeat
            Up := U; 
            if (Up mod 2 = 0) then
                U := Up div 2
            else
                U := 3*Up + 1;
            nbr := nbr + 1;
        until U = 1; 
        calcul := nbr;
    end;
{ ********** Génération du fichier Suite.dat ********** }
procedure generer (var F1: Tfichier1 ; var F2 : Tfichier2 ; p : integer);
    var
        S : suite;
        i , U0: integer;
    begin
        reset(F1);
        rewrite(F2);
        for i:=1 to p do 
            begin
                read(F1, U0);
                S.Dep := U0;
                S.Nb := calcul (U0);
                write(F2 , S);
            end;
    end;
{ ********** Recherche du minimal ********** }
function minimal (var F2 : Tfichier2 ; p : integer) : integer;
    var 
        min, i : integer;
        S : suite;
    begin
        read (F2,S);
        min := S.Nb;
        for i := 1 to p do 
        begin
            read(F2,S);
            if min > S.Nb then
                min := S.Nb;
        end;
    end;
{ ********** Affichage ********** }
procedure afficher (var F2 : Tfichier2  ;  p : integer);
    var
        min, i : integer;
        S : suite;
    begin
        min := minimal (F2, p );
        for i := 1 to p do
            begin
                read (F2,S);
                if (S.Nb = min) then 
                    writeln(S.Dep);
            end;
    end;
{ ********** Programme Principal ********** }
begin
    assign(F1, 'C:\Depart.dat');
    assign(F2, 'C:\Suite.dat');
	taille (p);
	remplir(F1,p);
	generer(F1,F2,p);
	afficher(F2,p);
    close (F1);
    close (F2);
end.

Merci d'avance pour votre aide :)

04/02/2017, 14h12
FChrisF
Je n'ai absolument pas vérifié la logique ni le traitement de votre algorithme (de toute façon, cela c'est justement votre travail) ...

Concernant votre erreur, il y a (au moins) plusieurs soucis, le principal concernant la lecture du fichier F2:

Problème1:
Il manque l'affectation du résultat à la fonction "minimal":
Code:

1 2 3 end; minimal := min; // ajoutez moi end;
Problème2:
Dans la fonction minimal (c'est là que se plante actuellement votre programme), vous lisez le fichier F2 alors que vous êtes en fin de fichier. Il faut demander de revenir en début de fichier pour pouvoir le parcourir dans son entier:
Code:

1 2 3 begin seek(F2,0); // ajoutez moi read (F2,S);
Toujours dans cette fonction, vous lisez un enregistrement de trop. Puisque vous lisez déjà le 1er enregistrement avant la boucle pour initialiser votre variable "min", il ne reste donc plus que "p-1" enregistrements à lire (et pas "p"):
Code:

1 2 3 min := S.Nb; for i := 2 to p do // modifiez moi begin
Problème3:
Problème identique au problème 2 dans la fonction "afficher". Vous devez réinitialiser la position dans le fichier F2 avant de pouvoir le parcourir à nouveau:
Code:

1 2 3 min := minimal (F2, p ); seek(F2,0); // ajoutez moi for i := 1 to p do

Un merci royal pour ton aide ... Problème résolu (y)
Voila le code final exécutable :

Code:

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
program Suit_Min;
type
	suite = record
		Dep, Nb : integer;
    end;
    Tfichier1 = file of integer;
    Tfichier2 = file of suite;
var
	p : integer;
    F1 : Tfichier1;
    F2 : Tfichier2;
{ ********** La saisie de P ********** }
procedure taille (var p : integer);
    begin
        repeat 
            writeln ('Donnez la taille du fichier');
            readln(p);
        until p in [2..30];
    end;
{ ********** Le remplisage du fichier "Depart.dat" ********** }
procedure remplir (var F1 : Tfichier1 ; p : integer);
    var
        U0, i : integer;
    begin
        rewrite(F1);
        for i:=1 to p do
            begin
                repeat
                    writeln('Donnez le ',i,' eme entier compris entre 2 et 1000 : ');
                    readln(U0);
                until U0 in [2..1000];
                write(F1,U0);
            end;
    end;
{ ********** Calcul de la suite ********** }
function calcul (U : integer) : integer;
    var
        Up, nbr : integer;
    begin
        nbr := 1;
        repeat
            Up := U; 
            if (Up mod 2 = 0) then
                U := Up div 2
            else
                U := 3*Up + 1;
            nbr := nbr + 1;
        until U = 1; 
        calcul := nbr;
    end;
{ ********** Génération du fichier Suite.dat ********** }
procedure generer (var F1: Tfichier1 ; var F2 : Tfichier2 ; p : integer);
    var
        S : suite;
        i , U0: integer;
    begin
        reset(F1);
        rewrite(F2);
        for i:=1 to p do 
            begin
                read(F1, U0);
                S.Dep := U0;
                S.Nb := calcul (U0);
                write(F2 , S);
            end;
    end;
{ ********** Recherche du minimal ********** }
function minimal (var F2 : Tfichier2 ; p : integer) : integer;
    var 
        min, i : integer;
        S : suite;
    begin
            reset (F2);
            read (F2,S);
            min := S.Nb;
            for i := 2 to p do 
                begin
                    read(F2,S);
                    if min > S.Nb then
                        min := S.Nb;       
                end;
            minimal := min;
        end;
{ ********** Affichage ********** }
procedure afficher (var F2 : Tfichier2  ;  p : integer);
    var
        min, i : integer;
        S : suite;
    begin
        min := minimal (F2, p );
        reset (F2);
        for i := 1 to p do
            begin
                read (F2,S);
                if (S.Nb = min) then 
                    writeln('Le terme DEP correspond au NB minimal est : ',S.Dep);
            end;
    end;
{ ********** Programme Principal ********** }
begin
    assign(F1, 'G:\Depart.dat');
    assign(F2, 'G:\Suite.dat');
	taille (p);
	remplir(F1,p);
	generer(F1,F2,p);
	afficher(F2,p);
    close (F1);
    close (F2);
end.