Дан текстовый файл. Посчитать число повторений в нём строчных английских букв ("a"-"z") и создать строковый файл, элементы которого имеют вид "буква"-"число повторений буквы". Буквы,отсутствующие в тексте не включать. Строки упорядочить по возрастанию кодов букв.
Подскажите метод решения или натолкните на мысль.
Артемий
10.03.2007 19:40
Открываем файл. Можно создать массив строк и добавить в цикле туда все строки файла.Можно и просто добавить в s: string 1-ую,2-ую,3-ую,..n-ую строку и каждый раз с ней работать.Дело в принципе твое.Делаешь цикл for c {Char}:='a' to 'z' do begin Далее в символ сh: char добавить по очереди каждый символ очередной строки и смотреть - ch=c ?. И так со всему строками, но только если символ повторился несколько раз,тогда открывай счетчик I: integer;!В конце цикла забиваешь в строковой файл "ch"-"i". И далее в цикле в сh добавится новая буква и опять по новой!
Открываем файл. Можно создать массив строк и добавить в цикле туда все строки файла.Можно и просто добавить в s: string 1-ую,2-ую,3-ую,..n-ую строку и каждый раз с ней работать.Дело в принципе твое.Делаешь цикл for c {Char}:='a' to 'z' do begin Далее в символ сh: char добавить по очереди каждый символ очередной строки и смотреть - ch=c ?. И так со всему строками, но только если символ повторился несколько раз,тогда открывай счетчик I: integer;!В конце цикла забиваешь в строковой файл "ch"-"i". И далее в цикле в сh добавится новая буква и опять по новой!
Не мог бы ты немного поподробней...пример катануть...
Артемий
11.03.2007 16:53
Ну попробуй вот так, если то..
var arr: array [1..20] of string[255]; ch,c: Char; count,d,a,i,o: Integer; st,s: String; t: text; fs: file of string[255]; begin a:=0; o:=0; count:=0; assign(t,'ban.dat'); assign(fs,'words.dat'); reset(t); rewrite(fs); while not eof(t) do begin Inc(a); readln(t,arr[a]); end; for ch:='a' to 'z' do begin for d:=1 to 20 do begin st:=arr[d]; if not (st='') then begin repeat inc(o); if st[o]=ch then begin inc(count); end; until o=length(st); o:=0; end else Break; end; if not (count=0) then begin str(count,s); s:='Word '+ch+' - '+s+' raz.'; write(fs,s); count:=0; end else count:=0; Continue; end;
Добавлено через 5 мин.
Цитата
Строки упорядочить по возрастанию кодов букв.
Пока сделано без этого
Rocket
11.03.2007 17:17
Цитата(Артемий2 @ 11.03.2007 16:53)
Ну попробуй вот так, если то..
Большое спасибо! Сейчас попробую запустить. Ааа...ну ещё всё-таки нужно упорядочить строки...
Rocket
11.03.2007 17:37
Что-то она не работает...Ничего не записывает в новый файл... А по алфавиту вроде бы должна раставлять.
Артемий
11.03.2007 20:18
Какой у тебя компилятор? Я это делал на Free Pascal!
Добавлено через 6 мин. У меня все откомпилилось..
Rocket
11.03.2007 21:59
Цитата(Артемий2 @ 11.03.2007 20:18)
Какой у тебя компилятор? Я это делал на Free Pascal!
Добавлено через 6 мин. У меня все откомпилилось..
Так у меня тоже, но в новый файл ничего не записывает!
Артемий
11.03.2007 22:05
Очень странно, у меня все работает.. Ты его текстовым открываешь?
volvo
11.03.2007 22:12
Вот так записывает?
var cnt: array['a' .. 'z'] of integer; s: string; i: integer; ch: char; f, r: text;
begin assign(f, 'text.txt'); reset(f); assign(r, 'letter.txt'); rewrite®; while not eof(f) do begin readln(f, s); for i := 1 to length(s) do if s[i] in ['a' .. 'z'] then inc(cnt[s[i]]); end; close(f);
for ch := 'a' to 'z' do if cnt[ch] > 0 then writeln(r, ch:2, ': ', cnt[ch]:3, '':3); close®;
end.
Rocket
11.03.2007 22:15
Цитата(Артемий2 @ 11.03.2007 22:05)
Очень странно, у меня все работает.. Ты его текстовым открываешь?
var arr: array [1..20] of string; ch,c: Char; count,d,a,i,o: Integer; st,s: String; t: text; fs:text; begin a:=0; o:=0; count:=0; assign(t,'asd.txt'); assign(fs,'asdf.txt'); reset(t); rewrite(fs); while not eof(t) do begin Inc(a); readln(t,arr[a]); end; for ch:='a' to 'z' do begin for d:=1 to 20 do begin st:=arr[d]; if not (st='') then begin repeat inc(o); if st[o]=ch then begin inc(count); end; until o=length(st); o:=0; end; end; if not (count=0) then begin str(count,s); s:=ch+' - '+s; writeln(fs,s); count:=0; end else count:=0; end; end.
Мне пришлось заменить строчный тип файла fs на text,компилятор ошибку выдавал в writeln(fs,s)... В чём косяк может быть?
Артемий
11.03.2007 22:16
удалил..
Rocket
11.03.2007 22:29
Цитата(volvo @ 11.03.2007 22:12)
Вот так записывает?
Да так записывает! Большое спасибо!
Артемий
11.03.2007 22:29
var arr: array [1..20] of string; ch,c: Char; count,d,a,i,o: Integer; st,s: String; t: text; fs:text; begin a:=0; o:=0; count:=0; assign(t,'ban.dat'); assign(fs,'words.dat'); reset(t); rewrite(fs); while not eof(t) do begin Inc(a); readln(t,arr[a]); end; for ch:='a' to 'z' do begin for d:=1 to 20 do begin st:=arr[d]; if not (st='') then begin repeat inc(o); if st[o]=ch then begin inc(count); end; until o=length(st); o:=0; end; end; if not (count=0) then begin str(count,s); s:=ch+' - '+s; writeln(fs,s); count:=0; end else count:=0; end; close(t); close(fs); readln
?
Rocket
11.03.2007 22:33
Ага! Пашет! Спасибо!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.