VPF::Посчитать сколько раз встречается слово в строке

Agentum

Дата 13.12.2008, 19:15 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 49
Регистрация: 10.12.2008

Репутация: нет
Всего: нет

Помогите исправить код в программе для подсчета сколько раз встречается каждое слово в строке

Код


uses crt;
   var
   s,s1,s2:string;
   i,n,p,j:integer;
   a:array[1..100] of string;
   b:array[1..100] of byte;
   prim:boolean;
   begin
   clrscr;
   writeln('ввод строки');
   readln(s);
   if s[1]<>' ' then s:=' '+s;
   j:=0;
   for i:=1 to length(s) do
      if s[i]=' ' then
       begin
      inc(i);
      while (s[i]<>' ') and (i<=length(s)) do
      begin
      s2:=s2+s[i];
      inc(i);
      end;
      inc(j);
      a[j]:=s2;
      end;

   for n:=1 to length(s) do
    for i:=1 to length(s)-1 do
      begin
      if (s[i]=' ') and (s[i+1]=' ') then
      delete(s,i,1);
      end;
      prim:=false;
      for i:=1 to n do
      begin
      s1:=a[i];
      for j:=1 to length(s) do
      begin
       if s[j]=s1[j] then
      while (s[j]=s1[j]) and (j<=length(s1)) do
            begin               if s[j]=s1[j] then prim:=true               else                     begin                   prim:=false;                      break;                     end;
inc(j);
 end;
if prim=true then inc(b[i]);
 end;
end;
for i:=1 to n do
writeln('1 слово',a[i],'встречается',b[i],'раз');
readkey;
end.

Это сообщение отредактировал(а) volvo877 - 13.12.2008, 22:00

volvo877

Дата 13.12.2008, 22:16 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Agentum, проще заново переписать, чем исправить, ты с циклами когда работаешь - не меняй НИКОГДА переменную цикла сам... Компилятор без тебя это сделает, тебе это делать запрещено! Табу... Изменил - получил глюк или программа вообще отказалась компилироваться...

Вот так я бы делал:

Код


uses crt;
var
  a: array[1..100] of string;
  b: array[1..100] of byte;

  s, s1: string;
  i, j, back, n: integer;
  found: boolean;
begin
   clrscr;
   writeln('ввод строки');
   readln(s);

   i := 1;
   n := 0;
   while i <= length(s) do begin

      while (i <= length(s)) and (s[i] = ' ') do inc(i);
      if i <= length(s) then begin
         back := i;
         while (i <= length(s)) and not(s[i] = ' ') do inc(i);

         s1 := copy(s, back, i - back);
         found := false;
         for j := 1 to n do begin
           if a[j] = s1 then begin
             b[j] := b[j] + 1; found := true;
           end;
         end;

         if not found then begin
           inc(n);
           a[n] := s1; b[n] := 1;
         end;
      end;

   end;

   for i:=1 to n do
     writeln(' слово',a[i],'встречается',b[i],'раз');
   readkey;
end.

Agentum

Дата 14.12.2008, 09:53 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 49
Регистрация: 10.12.2008

Репутация: нет
Всего: нет

Спасибо за помощь.Проверил сейчас,все работает. smile

даже лишние пробелы не стоит удалять. smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »