посчитать количество всех слов,слов-маркеров и процент слов-маркеров

[ksenya91]

посчитать количество всех слов,слов-маркеров и процент слов-маркеров.когда слов мало все считает.если их больше,идет переполнение строки.помогите исправить

program p1;
uses crt;
var
tx1,tx2:text;
tekst,t:string;
key,wrd:string;
keymas: array [1..1000] of string;
i,ki,l,sovp,j,kw:integer;
begin
clrscr;
tekst:=' ' ;
ki:=0;
Assign (tx1, '1.txt');
Assign (tx2, '2.txt');
reset(tx1);
reset(tx2);
while not EoF (tx1) do
begin
 readln(tx1,t);
 tekst:=tekst+t;
end;
writeln('текст из файла 1.txt: ', tekst);
close (tx1);
writeln('символов в тексте ', length (tekst));
while not EoF (tx2) do
begin
  t:= ' ';
  readln (tx2,t);
  l:=length (t);
  i:=1;
  key:= ' ';
  while i<=l do
  begin
  if(t[i]=' . ') or (t[i]=' ') then inc (i)
  else
  begin
    while i<=l do
    begin
        if(t[i]=' . ') or (t[i]=' ') or (i>l) then break;
        key:=key+t[i];
        inc(i);
        end;
        end;
        if key <>' ' then
        begin
         inc(ki);
         keymas[ki]:=key;
         key:= ' ';
         end;
         end;
         end;
         writeln('ключевые слова:');
         for i:=1 to ki do
         begin
           writeln(keymas[i]);
         end;
         writeln ('всего ключевых слов:', ki);
         close(tx2);
         l:=length (tekst);
         wrd:=' ';
         kw:=0;
         sovp:=0;
         i:=1;
         while i<=l do
            begin
              if(tekst[i]=' . ') or (tekst[i]=' ') then inc (i)
              else
              begin
              while i<=l do
    begin
        if(tekst[i]=' . ') or (tekst[i]=' ') or (i>l) then break;
        wrd:=wrd+tekst[i];
        inc(i);
        end;
        end;
        if wrd<> ' ' then
        begin
         inc(kw);
         key:=wrd;
         wrd:= ' ';
         for j:=1 to ki do
         begin
          if key=keymas[j] then
          begin
           inc(sovp);
           writeln('совпадение:', key);
           end;
           end;
           end;
           end;
    writeln('всего слов в тексте:', kw);
    writeln('всего совпадений:', sovp);
    writeln('процент ключевых слов:', (sovp/kw)*100, '%');
    readkey;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!

Модератор.

[Sibedir]

А можешь для примера скинуть эти самые 1.txt и 2.txt?

[ksenya91]

я не могу прикрепить файлы(((
в блокноте пишешь первый файл.например:
"Проверка и оценка успеваемости учащихся составляют важную часть учебного процесса, способствуют повышению качества обучения и воспитания. Проверка успеваемости учащихся позволяет не только определить успехи и недостатки в знаниях и умениях, но на этой основе управлять учебным процессом. Результаты проверки позволяют учителю корректировать время на изучение отдельных вопросов программы, совершенствовать формы и методы работы с учащимися, изменяя виды учебной работы, долю самостоятельной работы каждого ученика, оптимально регулировать учебную нагрузку школьников."
а во втором слова: учитель, ученик, учащийся,учиться,учимся
составляют, состав, составят

[Serge_Bliznykov]

uses crt;

это говорит о том, что Вы используете TurboPascal

var tekst:string;
...
while not EoF (tx1) do
begin
 readln(tx1,t);
 tekst:=tekst+t;
end;

Вы хотите целиком весь файл 1.txt запихнуть в переменную типа String
под TurboPascal такой фокус не пройдёт. Максимальная длина строки - 255 символов.
И всё! Поэтому либо заводите массив строк, либо (лучше) обрабатывайте исходный файл построчно:
пока не конец файла прочитали строку, обработали, перешли на начало цикла.

[Sibedir]

Т.е. еще раз:
Хранить весь текст не обязательно. Подсчитывать кол-во слов нужно параллельно с чтением их из файла.
1. прочитал слово (встретил пробел или знак припенания)
2. сравнил его с ключевым
3. сохранил результат (увеличил соответствующие счетчики)

[ksenya91]

да, так и нужно

[ksenya91]

а можно конкретно написать как это сделать.прям в программе исправить

[Sibedir]

Исправить?!! Девушка, вы смеётесь?

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  Txt: Text;
  KeyArr: array [1..1024] of ShortString;
  KeyArrLength, i, WordCount, KeyCount: Integer;
  c: AnsiChar;
  s: ShortString;

procedure AddSToKeyArr;
begin
  if s <> '' then begin
    s := AnsiUpperCase(s);
    for i := 1 to KeyArrLength do
      if s = KeyArr[i] then begin
        s := '';
        Break;
      end;
    if s <> '' then begin
      Inc (KeyArrLength);
      KeyArr [KeyArrLength] := s;
      s := '';
    end;
  end;
end;

procedure NewWord;
begin
  if s <> '' then begin
    Inc (WordCount);
    for i := 1 to KeyArrLength do
      if AnsiUpperCase(s) = KeyArr[i] then begin
        s := AnsiUpperCase(s);
        Inc (KeyCount);
        Break;
      end;
    Write (s);
    s := '';
  end;
end;

begin
  AssignFile (Txt, '2.txt');
  Reset (Txt);
  s := '';
  KeyArrLength := 0;
  while not EoF (Txt) do begin
    while not Eoln (Txt) do begin
      Read (Txt, c);
      if c in ['.', ',', ' '] then
        AddSToKeyArr
      else
        s := s + c;
    end;
    AddSToKeyArr;
    Readln (Txt);
  end;
  CloseFile (Txt);
  AddSToKeyArr;
  Writeln ('Всего маркеров (2.txt) - ', KeyArrLength);
  for i := 1 to KeyArrLength do
    Writeln ('  ', i, '. ', KeyArr[i]);

  AssignFile (Txt, '1.txt');
  Reset (Txt);
  WordCount := 0;
  KeyCount := 0;
  Writeln ('');
  Writeln ('ТЕКСТ (1.txt):');
  Writeln ('--------------------------------------------------------------------');
  while not EoF (Txt) do begin
    while not Eoln (Txt) do begin
      Read (Txt, c);
      if c in ['.', ',', ' '] then begin
        NewWord;
        Write (c);
      end
      else begin
        s := s + c;
      end;
    end;
    NewWord;
    Readln (Txt);
    Writeln ('');
  end;
  NewWord;
  Writeln ('--------------------------------------------------------------------');
  CloseFile (Txt);

  Writeln ('');
  Writeln ('Всего слов в тексте     - ', WordCount);
  Writeln ('Всего маркеров в тексте - ', KeyCount );
  Writeln ('Процент слов-маркеров   - ', (KeyCount/WordCount)*100, '%');

  Readln;
end.

Это Delphi XE3. Но принципиально должно работать и на TP. Нужно немножко подправить имена функций.
Для теста взял вот такое содержимое файлов. Вроде всё работает.

Сообщение от 1.txt

Проверка и оценка успеваемости учащихся составляют важную часть учебного процесса, способствуют повышению качества обучения и воспитания.
Проверка успеваемости учащихся позволяет не только определить успехи и недостатки в знаниях и умениях, но на этой основе управлять учебным процессом. Результаты проверки позволяют учителю корректировать время на изучение отдельных вопросов программы, совершенствовать формы и методы работы с учащимися, изменяя виды учебной работы, долю самостоятельной работы каждого ученика, оптимально регулировать учебную ё нагрузку школьников.

Сообщение от 2.txt

учитель, учителя,
ученик, ученика,
учащийся учащихся
учиться учимся
составляют,состав,составят.
ё

[ksenya91]

на паскале никак не могу исправить(((меняю и имена функций.но количество маркеров в тексте считает неправильно(((

[Sibedir]

Лан, выкладывай свой измененный вариант.
И выложи сюда текст результата работы своей программы.