Algo. & Prog. Bac 2020

par **haiethem** Sam 27 Juin - 10:45

Algorithmique et Programmation
Baccalauréat 2020
Examen TP (26 juin 2020)
Voici une solution pour le sujet pratique :
*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
uses wincrt;

var f,d7,d13:text; s,sg,v,e,nb,j:integer; n:string;

function divis13(n:string):boolean;
begin
s:=0;
sg:=-1;
while length(n)>3 do
begin
val(copy(n,length(n)-2,3),v,e);
s:=s+v*sg;
sg:=-sg;
delete(n,length(n)-2,3);
end;
val(n,v,e);
s:=s+v*sg;
divis13:=abs(s) mod 13 =0;
end;

function divis7(n:string):boolean;
var u,d,c,o,s,i:integer;
begin
repeat
u:=1;d:=3;c:=2;s:=0;o:=1;
for i:= length(n) downto 1 do
begin
if o mod 3 =1 then begin s:=s+(ord(n[i])-48)*u; u:=-u;end
else if o mod 3 =2 then begin s:=s+(ord(n[i])-48)*d; d:=-d; end
else begin s:=s+(ord(n[i])-48)*c;c:=-c;end;
o:=o+1;
end;
str(s,n);
until (s<10);
divis7:=(s=0)or(s=7);
end;

begin
assign(f,'c:\bac2020\nombre.txt');
assign(d7,'c:\bac2020\div7.txt');assign(d13,'c:\bac2020\div13.txt');
repeat writeln('donner nb : '); readln(nb);
until nb>=5;
rewrite(f);
for j:=1 to nb do {** REMPLISSAGE DU FICHIER NOMBRE **}
begin
readln(n);
writeln(f,n);
end;
close(f);
reset(f);rewrite(d7);rewrite(d13);
while not eof(f) do {** REMPLISSAGE DES FICHIERS DIV7 et DIV13 **}
begin
readln(f,n);
if divis13(n) then writeln(d13,n);
if divis7(n) then writeln(d7,n);
end;
close(f);close(d7);close(d13);

end.