Анализатор текстов, Частотный, семантический анализ текстов Опции

[ProtasSoft]

Коллеги, есть ли какие-нибудь исходники по обработке текстовых файлов.
Обработка блоков тестков разделенных набором символов.
Поиск слов (словосочетаний) в этих блоках. Подсчет частоты встречаемости.
Работа с лексемами и т.д.
Жду Ваших предложений

[volvo]

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

[ProtasSoft]

Есть текстовый файл с текстом, состоящием из отдельных блоков, разделенных набором символов, например следующей последовательностью: **??**.
Необходимо составить словарь (список в отдельном текстовом файле) слов и словосочетаний (последовательности слов) всего текста и каждого блока в отдельности с указанием частоты встречаемости.
Желательно иметь возможность создания лексем. В частности под механизмом создания лексемы я понимаю мехнизм нахождения в тексте слов, имеющих одинаковую подпоследовательность символов мощности >N и отличающихся от этой подпоследовательности на <<N символов.

[ProtasSoft]

Можно ли скопировать один текстовый файл в другой
следующим образом:

procedure create_vocabulary (file1,file2:string);

var
     
     f,g: text;
 
begin
  assign (g,file2);
  assign (f,file1);
  g:=f;
end.

[volvo]

Нет. Читай здесь: FAQ: Файлы - Копирование файлов

[ProtasSoft]

все компилируется, но результата нет.
подскажите где проблема

program RFP;
const
  source='data.txt';
  file2='filt2.txt';
  vocab='vocabul.txt';

procedure file_preprocess(file1_,file2_:string);
var
  f,res:text;
  symb:char;

begin {0}

 assign (f,file1_);
 reset(f);

 assign (res,file2_);
 rewrite (res);

 while not eof (f) do
   begin {1}

        while not eoln do
            begin {2}

                  read (f,symb);

                  if symb<>' ' then write (res, symb)
                     else write (res,CHR(13));

            end;  {2}

   end; {1}
close (f);
close (res);
end;  {0}


{===========================================================}
{     Выделение всех уникальных элементов в массиве         }
{          (создание частотного словаря текста)             }
{===========================================================}

procedure create_vocabulary (file1_:string);


var
  bufer: array[1..10000] of string;
  stroka: string;
  f,voc: text;
  schetchik,i,j,k:integer;

begin

 file_preprocess(file1_,file2);

 i:=0;
 assign (f,file2);
 reset(f);
 assign (voc,vocab);
 rewrite(voc);

 while not eof (f) do
   begin {1}
         inc(i);
      readln (f,bufer[i]);

   end;  {1}

 j:=1;

 while j<=i do
   begin {2}
      if bufer[j]<>'' then
           begin {3}
             stroka:=bufer[j];
             for k:=1 to i do
                begin {4}
                    if stroka=bufer[k] then
                          begin

                                bufer[k]:='';
                                inc(schetchik);

                          end;
                     write (voc,stroka);write (voc,' -+- ');
                     write (voc,schetchik); writeln(voc);
                end;  {4}
           end; {3}
   end; {2}



 erase (f);
 close (voc);

end;

begin

create_vocabulary (source);
end.

[volvo]

Я не знаю, что именно ты задумывал в этой программе, и какие у тебя были файлы данных, но с моими файлами она в 2-х местах входила в бесконечный цикл:
1) в процедуре file_preprocess замени

 while not eof (f) do
   begin {1}

на

 while not seekeof (f) do
   begin {1}

2)

 while j<=i do begin {2}
      if bufer[j]<>'' then begin {3}
             stroka:=bufer[j];
             for k:=1 to i do begin {4}
                    if stroka=bufer[k] then begin

                                bufer[k]:='';
                                inc(schetchik);

                    end;
                    write (voc,stroka);write (voc,' -+- ');
                    write (voc,schetchik); writeln(voc);
             end;  {4}
      end; {3}

      inc(j);  { <--- !!! Увеличиваем J !!! --- }

 end; {2}

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

[ProtasSoft]

После внесения исправлений результирущих файлов по-прежнему нет

[volvo]

Ну, так что, мы по прежнему должны ДОГАДЫВАТЬСЯ, что именно у тебя хранится в файле данных? Или ты уже научишься, задавая вопрос, присоединять не только (и не столько) программу, но и файл данных? Я же сказал, что с моим файлом все отработало, значит проблема - в твоем DATA.TXT...

[ProtasSoft]

В качестве содержимого data.txt может быть любой текст, в т.ч. и англоязычный.
Пример:

лkljdfgl;k ждлапждл длвашщ ждлвапджл ждлвапджл оллошгкеш iuretiu 8 jkh 7 jh jh 78 орорпа б.ьцуждчсмшщзг 45 жлчсм 34 opiop43poi poi po poi    poipoispo 90,.nxcv87wlkjagrpu9 90908 9098 kj23490sdk;jl8cv -8-09 0-9-09 op;p=-034=-0 'kl;klsfg98908 lkjfg9034...

Кроме того, подскажите где посмотреть ASCII коды русских букв.

Сообщение отредактировано: ProtasSoft - 27.08.2005 13:36

[volvo]

И ты хочешь сказать, что при запуске программы с моими исправлениями у тебя нет результирующих файлов (или они пустые?)... Очень интересно. Тогда посмотри, что получилось у меня (результ. файлы) - и заодно попробуй у себя запустить программу (test.pp).

Мне почему-то кажется, что у тебя какая-то проблема с опциями компилятора

[ProtasSoft]

Спасибо за inc(j).
Вот, что у меня получилось:

program RFP;

const
  source='data.txt';
  file2='filt2.txt';
  vocab='vocabul.txt';
  

  var
  symb1:char;



procedure file_preprocess(file1_,file2_:string);

var

sourf,res:text;
symb:char;


begin {0}

 assign (sourf,file1_);
 reset(sourf);

 assign (res,file2_);
 rewrite (res);

 while not eof (sourf) do
   begin {1}

        while not eoln (sourf) do
            begin {2}

                  read (sourf,symb);

                  if (ORD(symb)>=65) and (ORD(symb)<=90) OR
                     (ORD(symb)>=97) and (ORD(symb)<=122) then 
                             begin {33}
                                       if (ORD(symb)>=65) and (ORD(symb)<=90) then
                                         write (res, chr(ord(symb)+32))
                                       else write (res, symb); 
                             end   {33}
                     else
                         begin {11}
                            if (ORD(symb)=38) then write (res, symb)
                                  else
                                      begin {22}
                                         writeln (res);
                                         {writeln (res, symb);}
                                      end;  {22}

                         end; {11}


            end;  {2}
        readln (sourf);
        writeln(res);
   end; {1}
close (sourf);
close (res);
end;  {0}

{===========================================================}
{     Выделение всех уникальных элементов в массиве         }
{          (создание частотного словаря текста)             }
{===========================================================}

procedure create_vocabulary (file1_:string);


var
  bufer: array[1..7000] of string [30]; {Здесь у меня ПРОБЛЕМА.
    ЧТО можно сделать чтобы можно было поставить, например, 100 000???}

  str1,stroka: string;
  f,voc: text;
  schetchik,i,j,k:integer;

begin

 

 i:=0;

 assign (f,file1_);
 reset(f);

 

 while not eof (f) do
   begin {1}
         
         readln (f,stroka);
         
         if stroka<>'' then 
             begin
               inc(i); 
               bufer[i]:=stroka 
             end; 
   end;  {1}

 close (f);

   
 assign (voc,vocab);
 rewrite(voc);

 j:=1;

 while j<=i do
   begin {2}
      if bufer[j]<>'' then
           begin {3}
             stroka:=bufer[j];
              schetchik:=0;
              for k:=1 to i do
                begin {4}
                    if stroka=bufer[k] then
                          begin

                                bufer[k]:='';
                                inc(schetchik);

                          end;
                              
                end;  {4}
              
              str(schetchik,str1);
              stroka:=concat(stroka,' ............... ',str1);
              writeln (voc,stroka);

           end; {3}
     inc(j);
   end; {2}



 
 close (voc);

end;


begin
file_preprocess(source,file2);
create_vocabulary (file2);
end.

Теперь у меня проблема с размерностью массива.
Не могу его увеличить даже до 8000 - при таком размере комп не выдает результатов. HELP

[volvo]

Спасибо за inc(j)

Я еще в посте №7 сказал, что это надо было сделать... Без этого программа входит в бесконечный цикл...

По поводу 8000 элементов: ты наступаешь второй раз - на те же грабли Вынеси описание

const
  max_count = 100000;
var
  bufer: array[1..max_count] of string [30];

из процедуры и сделай этот массив глобальным, у тебя просто не хватает стека, чтобы затолкать в него больше 3-х Мб данных (если массив описан локально)... У меня прекрасно отработало при

max_count = 100000;

, но на всякий случай счетчики i, j, k я сделал типа LongInt ...

[ProtasSoft]

:flowers:
Огромное спасибо за помощь.
Следуя Вашим советам, все заработало!