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

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

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

 
 Ответить  Открыть новую тему 
> Задача на частотный анализ текстового файла
сообщение
Сообщение #1


Гость






Собственно, условие подобной задачи (олимпиадской) на форуме приводилось (решение - нет):
Привожу еще раз условие:
Дан текст, в котором встречаются слова, состоящие из букв русского и латинского алфавитов и цифр, знаки препинания, пробелы и переводы строк. Требуется найти количество вхождений каждого слова в этот текст Для каждого слова при выводе в скобках указать количество его вхождений в текст.
*************************************************************************
Понятно, что решение надо делать через двоичное дерево. Часть программы есть, но не допру, как дальше:
uses
crt;
type
{ссылка на узел дерева}
TFindTreePtr = ^TFindTreeNode;
TFindtreeNode = record
info: word;
count: integer;
left, right: TFindTreePtr;
end;
var
InFile: Text; {исходный файл}
FileName: string; {имя файла данных}
root: TFindTreePtr;
str: word; {текущий обрабатываемое слово}
ErrCode: integer; {код ошибки при открытии файла}
ask: char; {символ-отклик при выборе режима вывода}
procedure Search (c: string; var node: TFindTreePtr);
begin
if node=nil then begin
node:=New(TFindTreePtr);
node^.info:=c;
node^.count:=1;
node^.left:=nil; {новый лист}
node^.right:=nil;
end
else if c< node^.info then
Search (c,node^.left)
else if c>node^.info then
Search (c,node^.right)
else
node^.count := node^.count+1;
end;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


type
PTInfo = ^TInfo;

TInfo = Record
_word: String;
_count: LongInt;
_next: PTInfo;
end;

PTInfoList = ^TInfoList;

TInfoList = object
first, last: PTInfo;

constructor Create(const file_name: String);
procedure Run;
destructor Free;

procedure Push(const _word: String);
procedure PushOrInc(const _word: String);

procedure Print;
end;


constructor TInfoList.Create(const file_name: String);
const
limits = ['.', ',', ' ', '!', '?', ';', ':'];
var
f: Text;
i, back: Byte;
s: String;

begin
first := nil;
last := nil;

assign(f, file_name);

{$I-}
reset(f);
{$I+}

if IOResult <> 0 then begin
writeln('can''t open file "' + file_name, '"');
readln;
halt(1);
end;

while not eof(f) do begin
readln(f, s);

i := 1;
while (i <= length(s)) do begin
while (i <= length(s)) and (s[i] in limits) do
inc(i);

if i <= length(s) then begin
back := i;

while (i <= length(s)) and not (s[i] in limits) do
inc(i);

PushOrInc(copy(s, back, i - back));
end;

end;
end;
end;

destructor TInfoList.Free;
var
T: PTInfo;
begin
while first <> nil do begin
T := first;
first := first^._next;
Dispose(T);
end;
end;

procedure TInfoList.Push(const _word: String);
var
T: PTInfo;
begin
New(T);

T^._word := _word;
T^._next := nil;
T^._count := 1;

if first = nil then
first := T
else
last^._next := T;

last := T;
end;

procedure TInfoList.PushOrInc(const _word: String);
var
T: PTInfo;
begin
T := first;
{$B-}
while (T <> nil) and (T^._word <> _word) do
T := T^._next;
{$B+}
if T <> nil then
inc(T^._count)
else
Push(_word);
end;

procedure TInfoList.Print;
var
T: PTInfo;
begin
T := first;
while first <> nil do begin
writeln(first^._word, '(', first^._count, ')');
first := first^._next;
end;
first := T;
end;

procedure TInfoList.Run;
begin
Print;
end;

var
info_list: PTInfoList;
begin
New(info_list, Create('C:\test.txt'));

info_list^.Run;

Dispose(info_list, Free);
end.


Сообщение отредактировано: klem4 -


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Спасибо огромное! Буду разбираться smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Michael_Rybak
*****

Группа: Пользователи
Сообщений: 1 046
Пол: Мужской
Реальное имя: Michael_Rybak

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


Цитата
Понятно, что решение надо делать через двоичное дерево


Мне это совсем непонятно. Ее нужно делать через trie.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


Да, кстати, двоичных деревьев в решении я не использовал, обычный список ...


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Winniepoohless,
вопрос на засыпку: слова 'Привет' и 'привет' считаются одинаковыми или разными?

klem4, к тебе тоже есть вопрос - почему не так:
procedure TInfoList.Print;
var T: PTInfo;
begin
T := first;
while T <> nil do
with T^ begin
writeln(_word, '(', _count, ')');
T := _next;
end;
end;

? Зачем лишние движения с first-ом делать?

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


volvo, ага чо-то намудрил я мальца в этом месте ..


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Да, "Привет" и "привет" считаются одинаковыми. И от этого не легче
Цитата(volvo @ 31.01.2008 19:06) *

Winniepoohless,
вопрос на засыпку: слова 'Привет' и 'привет' считаются одинаковыми или разными?

klem4, к тебе тоже есть вопрос - почему не так:
procedure TInfoList.Print;
var T: PTInfo;
begin
T := first;
while T <> nil do
with T^ begin
writeln(_word, '(', _count, ')');
T := _next;
end;
end;

? Зачем лишние движения с first-ом делать?

 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Цитата
И от этого не легче
Естественно. Тогда придется хранить не сами слова, а преобразованные, скажем к верхнему регистру, чтобы не было нескольких вхождений одного и того же слова только из-за того, что изменился регистр одной буквы...

Как это делать - ищи на форуме, была функция перевода строки в верхний рагистр, корректно работающая и с кириллицей, и с латиницей...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






Цитата(klem4 @ 31.01.2008 19:02) *

Да, кстати, двоичных деревьев в решении я не использовал, обычный список ...


Насчет того, что через обычный список я увидел... smile.gif Но никак не пойму, почему у меня ошибка вылазит при запуске программы - can't open file c:\test.txt
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Цитата(volvo @ 1.02.2008 16:16) *

Естественно. Тогда придется хранить не сами слова, а преобразованные, скажем к верхнему регистру, чтобы не было нескольких вхождений одного и того же слова только из-за того, что изменился регистр одной буквы...

Как это делать - ищи на форуме, была функция перевода строки в верхний рагистр, корректно работающая и с кириллицей, и с латиницей...


поищу. а через апкейс нельзя?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


The matrix has me!!!
**

Группа: Пользователи
Сообщений: 74
Пол: Мужской
Реальное имя: Евгений

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


Цитата
Но никак не пойму, почему у меня ошибка вылазит при запуске программы - can't open file c:\test.txt


Посмотри вот в эти места в программе и разберись...
begin
New(info_list, Create('C:\test.txt')); <<===

info_list^.Run;

Dispose(info_list, Free);
end.


assign(f, file_name);

{$I-}
reset(f);
{$I+}

if IOResult <> 0 then begin
writeln('can''t open file "' + file_name, '"'); <<===
readln;
halt(1);
end;


Может быть у тебя просто нет такого файла??? smile.gif


--------------------
"Брать производную можно научить даже обезьяну" - мой препод по матану! :-)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






Цитата(Yevgeny @ 1.02.2008 16:45) *

Посмотри вот в эти места в программе и разберись...
begin
New(info_list, Create('C:\test.txt')); <<===

info_list^.Run;

Dispose(info_list, Free);
end.


assign(f, file_name);

{$I-}
reset(f);
{$I+}

if IOResult <> 0 then begin
writeln('can''t open file "' + file_name, '"'); <<===
readln;
halt(1);
end;


Может быть у тебя просто нет такого файла??? smile.gif

Название своего файла (для анализа) я вставляю после assign
А функция IOResult, вроде, просто проверяет правильность выполнения операции (если 0, то ок).
Но чего-то не идет...Можешь у себя попробовать,если вдруг захочется

 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Цитата
Но чего-то не идет...
Это не классификация ошибки... Что именно не идет? Что происходит? Что выводит программа? Файл существует? Он не заблокирован другим приложением? Вот я попробовал - все нормально открылось и отработало... Что я делаю не так?

Цитата
а через апкейс нельзя?
Нельзя. Он работает только с латинскими символами, с русскими получишь проблему...

Добавлено через 1 мин.
Цитата
Название своего файла (для анализа) я вставляю после assign
Название своего файла надо передавать в Create (как это и сделано во втором посте), а не перековыривать всю программу, а потом говорить, "что-то не работает"...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






Цитата(volvo @ 1.02.2008 17:34) *

Это не классификация ошибки... Что именно не идет? Что происходит? Что выводит программа? Файл существует? Он не заблокирован другим приложением? Вот я попробовал - все нормально открылось и отработало... Что я делаю не так?

Нельзя. Он работает только с латинскими символами, с русскими получишь проблему...

Добавлено через 1 мин.
Название своего файла надо передавать в Create (как это и сделано во втором посте), а не перековыривать всю программу, а потом говорить, "что-то не работает"...



Я разобрался, все заработало. Спасибо огромнейшее!!! smile.gif Буду через функцию с преобразованием к верхнему регистру копаться
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 1.12.2020 19:06
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name