IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Русская прописная буква
сообщение
Сообщение #1


Гость






Добрые люди, помогите написать прогу!!!
Значит, в файле набран текст. Надо опрелелить какая русская прописная буква встречается чаще всего в этом тексте.
Я сделал так:
Код
[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]

Но препод сказал, что можно гораздо проще!!??...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Если препод сказал, значит можно ;)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Это короче?
Код

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.

А вот как еще короче, я не знаю


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Спасибо!!!

Оперативно ты ее решил!
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 20.09.2017 11:04
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"