PascalABC, файлы

[IDejA]

даны 2 текстовых файла : text.txt - в нем текст большого объема произвольной темы; key.txt - ключевые слова (20 слов + все возможные вариации этих слов(текст, текстовый, текстов...)). Необходимо подсчитать количество ключевых слов в данном тексте (вот с этим и проблема)
заранее спасибо.

Const mn=[' ',',','.','?','!'];
Var f1,f2:text;
    s,s2,sl:string;
    i,k1,k2:integer;
Begin
    Assign(f1,'text.txt');
    Reset(f1);
    While not Eof(f1) do
    Begin
      readln(f1,s);
      s:=s+' ';
      For i:=1 to Length(s) do
      Begin
        if not(s[i] in mn) then sl:=sl+s[i]
        else
        Begin
          if sl<>'' then inc(k1);
          sl:='';
        End;
      End;
    End;
    writeln('всего слов в тексте = ',k1);
    Close(f1);
   
 // до этого момента все хорошо, но я не знаю
// как из одного файла взять слово и прогнать его по всему тексту из другого файла,
// запуталась уже окончательно:confused:
 
       k2:=0;
     Assign(f1,'text.txt');
    Reset(f1);
      Assign(f2,'key.txt');
    Reset(f2);
 
    While not Eof(f1) do
Begin
      readln(f2,s2);
         readln(f1,s);
        if s=s2 then k2:=k2+1;
end;
 
    writeln('ключевых слов в тексте = ',k2);
    Close(f1);
    Close(f2);
    
    if k2/k1*100>10 then
    writeln('данныей текст такой-то темы')
    else writeln('данный текст неизвестной темы') ;
End.

[Stilet]

По-хорошему так не делают, но тебе можно )
Все равно не пожелаешь разобратьтся...

     Assign(f1,'text.txt');    Reset(f1);
      Assign(f2,'key.txt');    Reset(f2);
 
    While not Eof(f2) doBegin
         readln(f2,s2);
         reset(f1); while not Eof(f1) do begin
           readln(f1,s);
           if s=s2 then k2:=k2+1;
         end;
    end;

[min@y™]

А обязательно ABC использовать?

[Serge_Bliznykov]

Виталий, так не будет работать.
У неё же в исходном тексте ТЕКСТ (а не отдельные слова).
(обратите внимание на первую часть программы, где она выделяет группы символов, разделённых знаками препинания и пробелами (см. mn) и подсчитывает их количество.



IDejA, только потому, что у Вас были качественные наработки по чтению и разбору текста,
вот, в качестве БОНУСА, полностью работающий код:

Const mn=[' ',',','.','?','!'];
Const
   KeyFileName = 'key.txt'; {имя файла с ключевыми словами}
   MaxKeywords = 400; {максимально в файле прочитается столько ключевых слов}

Var f1:text;
    s,sl:string;
    i,j,k1,k2:integer;
    keywords : array[1..MaxKeywords] of string[80];
    nkeys : integer;
Begin
    Assign(f1, KeyFileName);
    Reset(f1);
    nkeys := 0;
    while not eof(f1) do begin
       ReadLn(f1, s);  {ВНИММАНИЕ! КАЖДОЕ КЛЮЧЕВОЕ СЛОВО ДОЛЖНО БЫТЬ
                            НА ОТДЕЛЬНОЙ СТРОКЕ!}
       if Trim(s)<>'' then
         begin Inc(nkeys); keywords[nkeys] := s; end;
       if nkeys = MaxKeywords then begin
         WriteLn('Из файла ',
            KeyFileName,' прочитано максимальное число слов (',MaxKeywords,')');
         WriteLn('Оставшиеся ключевые слова игнорируются...');
         WriteLn;
         Break
       end;
    end;
    Close(f1);
    
    WriteLn('Для отладки выведем список прочитанных ключевых слов:');
    for i:=1 to nkeys do Write(keywords[i],' '); WriteLn;

    {обработка исходного файла}
    Assign(f1,'text.txt');
    Reset(f1);
    k1 := 0;  {счётчик слов в исходном тексте}
    k2 := 0;  {счётчик слов в исходном тексте, совпавших с ключевыми}
    While not Eof(f1) do
    Begin
      readln(f1,s);
      s:=s+' ';
      For i:=1 to Length(s) do
      Begin
        if not(s[i] in mn) then sl:=sl+s[i]
        else
        Begin
          if sl<>'' then begin
             inc(k1);
                 // отладка - вывод слов текста Write(UpperCase(sl), ' ');

             // найдём,есть ли совпадения с ключевыми словами
             for j:=1 to nkeys do
               if UpperCase(sl) = UpperCase(keywords[j]) then begin
                 Inc(k2);
                 Break
               end;

          end;
          sl:='';
        End;
      End;
    End;
    Close(f1);
    WriteLn;
    writeln('всего слов в тексте = ',k1);
    writeln('ключевых слов в тексте = ',k2);

    if k1>0 then begin
      WriteLn('процент совпадения = ',(k2/k1*100):2:1,'%');
      if k2/k1*100>10 then
      writeln('данный текст такой-то темы')
      else writeln('данный текст неизвестной темы') ;
    end;
End.

[Stilet]

У неё же в исходном тексте ТЕКСТ (а не отдельные слова).

Ну может быть. Файлов то не прикладено )

[IDejA]

Все работает, СПАСИБО Вам огромное!

[Serge_Bliznykov]

пожалуйста!

тему закрываю...