fisiere 2
6. Fişierul litere.txt conţine un text scris cu litere mari pe una sau mai multe linii. Se cere:
a) Să se afişeze litera ( literele) care apare de cele mai multe ori;
b) Să se afişeze vocalele din text.
var f:text;
a:array[char]of byte;
procedure citire;
var c:char;
begin
while (not eof(f)) do begin
read(f,c);
a[c]:=a[c]+1;
end;
close(f);
end;
procedure initializare;
var i:char;
begin
for i:=#0 to #255 do a[i]:=0;
end;
procedure maxim;
var c:char;max:integer;
begin
max:=a['A'];
for c:='B' to 'Z' do
if max<a[c] then max:=a[c];
for c:='a' to 'z' do
if max<a[c] then max:=a[c];
writeln('Literele care apar cel mai des sunt ');
for c:='A'to 'Z' do
if a[c]=max then write(c,' ');
for c:='a' to 'z' do
if a[c]=max then write(c,' ');
writeln;
end;
procedure vocale;
begin
if a['a']<>0 then writeln('a apare de ',a['a'],' ori');
if a['A']<>0 then writeln('A apare de ',a['A'],' ori');
if a['e']<>0 then writeln('e apare de ',a['e'],' ori');
if a['E']<>0 then writeln('E apare de ',a['E'],' ori');
if a['i']<>0 then writeln('i apare de ',a['i'],' ori');
if a['I']<>0 then writeln('I apare de ',a['I'],' ori');
if a['o']<>0 then writeln('o apare de ',a['o'],' ori');
if a['O']<>0 then writeln('O apare de ',a['O'],' ori');
if a['u']<>0 then writeln('u apare de ',a['u'],' ori');
if a['U']<>0 then writeln('U apare de ',a['U'],' ori');
end;
begin
assign(f,'litere.txt');
reset(f);
initializare;
citire;
maxim;
vocale;
end.
12. Fişierele cuv1.txt şi cuv2.txt conţin cuvinte, câte un cuvânt pe linie în ordine alfabetică. Să se construiască fişierul cuv3.txt care să conţină toate cuvintele din cele două fişiere, în ordine alfabetică.
var
a,b,c:array[1..50] of string;
n,m:byte;
procedure citire;
var i:byte;f1,f2:text;
begin
assign(f1,'cuv1.txt');reset(f1);
n:=0;
while not eof(f1) do
begin
n:=n+1;
readln(f1,a[n]);
end;
close(f1);
assign(f2,'cuv2.txt');reset(f2);
m:=0;
while not eof(f2) do
begin
m:=m+1;
readln(f2,b[m]);
end;
close(f2);
end;
procedure interclasare;
var i,j,k:byte;f3:text;
begin
i:=1;j:=1;k:=0;
while(i<=n)and(j<=m) do
if(a[i]<b[j]) then
begin
k:=k+1;
c[k]:=a[i];
i:=i+1;
end
else begin
k:=k+1;
c[k]:=b[j];
j:=j+1;
end;
if j<=m then for i:=j to m do begin
k:=k+1;
c[k]:=b[i];
end;
if i<=n then for j:=i to n do begin
k:=k+1;
c[k]:=a[j];
end;
assign(f3,'cuv3.txt');rewrite(f3);
for i:=1 to n+m do write(f3,c[i],' ');
close(f3);
end;
begin
citire;
interclasare;
end.
13. Fie fişierul bingo.txt cu maxim 90 de numere naturale. Se cere:
a) să se calculeze cmmdc al numerelor din fişier;
b) valoarea maximă din vector şi poziţiile pe care se află. Rezultatele se vor afişa la sfârşitul fişierului.
var f:text;
a:array[1..90]of word;
n:integer;
procedure citire;
var i:byte;
begin
assign(f,'bingo.txt');reset(f);
n:=0;
while(not seekeof(f)) do begin
n:=n+1;
read(f,a[n]);
end;
close(f);
end;
procedure afisare;
var i:byte;
begin
writeln(f);
writeln(f,'volorile citite');
for i:=1 to n do write(f,a[i],' ');
writeln(f);
end;
function cmmdc(a,b:word):word;
begin
while a<>b do
if a>b then a:=a-b
else b:=b-a;
cmmdc:=a;
end;
procedure cmmdcn;
var i:byte;c:word;
begin
c:=cmmdc(a[1],a[2]);
for i:=3 to n do
c:=cmmdc(c,a[i]);
writeln(f,'cmmdc=',c);
end;
procedure maxim;
var i:byte;max:word;
begin
max:=a[1];
for i:=2 to n do
if a[i]>max then max:=a[i];
writeln(f,'max=',max);
writeln(f,'pozitiile pe care se elementul maxim');
for i:=1 to n do
if a[i]=max then write(f,i,' ');
end;
begin
citire;
assign(f,'bingo.txt');append(f);
afisare;
cmmdcn;
maxim;
close(f);
end.
