Program sujet3;
Uses crt;
Type
fnat = file Of word;
Var
f,fr,fnr : fnat;
n : integer;
//*****************************************
Procedure creation(Var f:fnat;n:integer);
Var
i : integer;
m : word;
Begin
assign(f,'c:\bac2008\naturels.dat');
rewrite(f);
For i:=1 To n Do
Begin
Repeat
write('saisir un entier naturel: ');
readln(m);
Until (m >=0)And (m<32000);
write(f,m);
End;
close(f);
End;
//*****************************************
Function conv_bin(dec:word) : string;
Var
r : word;
ch_bin,chr : string[20];
Begin
ch_bin := '';
Repeat
r := dec Mod 2;
str(r,chr);
ch_bin := chr+ch_bin;
dec := dec Div 2
Until (dec =0);
conv_bin := ch_bin;
End;
//*****************************************
Function rond(nb:word) : boolean;
Var
n0,n1,i : integer;
ch : string;
Begin
ch := conv_bin(nb);
n0 := 0;
n1 := 0;
For i:=1 To length(ch) Do
If (ch[i]='0') Then
n0 := n0+1
Else
n1 := n1+1;
If (n0=n1) Then
rond := true
Else
rond := false;
End;
//*****************************************
Procedure eclat(Var f,fr,fnr:fnat);
Var
nb : word;
ch : string;
Begin
assign(fr,'c:\bac2008\round.dat');
rewrite(fr);
assign(fnr,'c:\bac2008\non_round.dat');
rewrite(fnr);
reset(f);
While (Not(eof(f))) Do
Begin
read(f,nb);
If (rond(nb)) Then
Begin
write(fr,nb);
ch := conv_bin(nb);
writeln('Le nombre ',nb,' est round car ',nb,'=(',ch,')2');
End
Else write(fnr,nb);
End;
close(fr);
close(fnr);
close(f);
End;
//*****************************************
Begin
Repeat
write('Saisir le nombre des entiers: ');
readln(n);
Until ( n In [10..100]);
creation(f,n);
clrscr;
writeln('------------------------------------------');
writeln;
writeln('---- LISTE DES ENTIERS NATURELS RONDS ----');
writeln;
writeln('------------------------------------------');
writeln;
eclat(f,fr,fnr);
End.
Inscription à :
Publier les commentaires (Atom)
