Автор: LinkIn 13.12.2003 18:25
Добрые люди, помогите написать прогу!!!
Значит, в файле набран текст. Надо опрелелить какая русская прописная буква встречается чаще всего в этом тексте.
Я сделал так:
Код
[size=3]program a;
var f1,z3:text; sts:array[1..50] of string; chrs:array[1..50] of char;
i,n,m,max,k,l,k2,l2,k3,l3,max2:integer; pro:set of 'А'..'Я';
ch1,ch2,ch3:char;
begin
assign(f1,'f1.txt');
assign(z3,'z3.txt');
reset(f1);
rewrite(z3);
i:=0; max:=0; max2:=0;
while not eof(f1) do begin
i:=i+1;
readln(f1,sts[i]);
end;
for n:=1 to i do
for m:=1 to length(sts[n]) do
pro:=pro+[sts[n][m]];
for n:=1 to i do
for m:=1 to length(sts[n]) do
if (sts[n][m] in pro) then begin
max2:=0;
for k:=1 to i do
for l:=1 to length(sts[k]) do begin
if (sts[n][m]=sts[k][l]) then begin
max2:=max2+1; k2:=k; l2:=l;
end;
end;
if (max<max2) then begin
max:=max2; k3:=k2; l3:=l2;
end;
end;
writeln(sts[k3][l3]);
close(f1);
close(z3);
end.[/size]
Но препод сказал, что можно гораздо проще!!??...
Автор: UtaH 13.12.2003 18:59
Если препод сказал, значит можно ;)
Автор: trminator 13.12.2003 19:31
Это короче?
Код
var f : text;
i : integer;
a : array[1..255] of integer;
c : char;
max : integer;
maxn : byte;
begin
assign(f, 'c:TEMPtest.txt');
reset(f);
fillchar(a, sizeof(a), 0); {Зануляю массив a}
while not eof(f) do
begin
read(f, c); {считали символ}
inc(a[byte(c)]) {и пометили, что он встретился еще раз}
end;
{Осталось найти максимум в этом массиве}
max := -1;
for i:=128 to 159 do {в этом диапазоне находятся заглавные русские буквы}
if a[i] > max then begin
maxn:=i; max:=a[i] end;
writeLn('Answer: ', char(maxn),' ', max,' times');
close(f)
end.
А вот как еще короче, я не знаю