Uloha 12

[mareq]

Kód: Vybrať všetko

Janko robil výskum o krstných menách vo svojej rodine a chce zistiť frekvenciu ich výskytu. Napíšte program, ktorý z poľa, v ktorom sú uložené krstné mená predkov, vytvorí dve nové polia. V jednom sú všetky krstné mená, ktoré boli v pôvodnom poli, ale žiadne meno sa neopakuje. V druhom poli je počet, koľkokrát sa príslušné meno vyskytlo v pôvodnom poli. Na obrazovku sa vypíše tabuľka, koľkokrát sa ktoré meno v rodine vyskytlo...

Máte to niekto ?

[admin]

{okomentovať, doplniť!!!! upgrade! }

uses crt;
const n=10;
type pole=array[1..n] of string;
pole_cis=array[1..n] of byte;
const mena:pole=('Adam','Martin','Adam','Tibor','Martin','Tibor','Adam','Luco','Adam','Ivan');
var z_mena:pole;
tab:pole_cis;
i,j,k,pom,poc:byte;

procedure frekv_tab(a:pole;var b:pole;var t:pole_cis);
begin
for i:=1 to n do
begin
b[i]:='';
t[i]:=0
end;
j:=0;
for i:=1 to n do
begin
pom:=1;
while (pom<=j) and (b[pom]<>a[i]) do inc(pom);
if b[pom]=a[i] then inc(t[pom])
else
begin
inc(j);
b[j]:=a[i];
inc(t[j])
end;
end;
end;
{nepouziva pomocne pole, ale pracuje rovno s polom mien}
procedure frekv_tab1(var a:pole;var t:pole_cis);
var ap:byte;
begin
for i:=1 to n do t[i]:=0;
ap:=n;
t[1]:=1;
poc:=1;i:=2;
while (i<=ap) do
begin
j:=1;
while (j<=poc) and (a[i]<>a[j]) do inc(j);
if j<=poc then
begin
inc(t[j]);
for j:=i to ap-1 do a[j]:=a[j+1];
a[ap]:='';
dec(ap);
end
else
begin
inc(poc);
t[poc]:=1;
inc(i);
end;
end;
end;

begin
clrscr;
for i:=1 to n do write(mena[i],' ');
writeln;
writeln;
writeln('Vyskyty mien v povodnom poli: ');
frekv_tab(mena,z_mena,tab);
{frekv_tab1(mena,tab);}
for i:=1 to j do writeln(z_mena[i]{mena[i]}:8,tab[i]:6);
readln;
end.