Паскаль (строки)..что-то не сходится..

[boloboshenku]

Задачка из контрольной: В тексте слова отделены пробелами. Найти все слова, содержащие три одинаковые буквы (необязат. стоящие рядом). Я написал. Сначала разбил строку на слова (в массив)..Затем по каждому слову прошелся..Вроде все правильно, но в результате, программа неправильно фильтрует слова..Помогите разобраться?!..

program kontr2_3;
uses crt;

type
  twords = array[1 .. 30] of string[10];
var st:string;
    d,e,f,k,m,n:integer;
    a,b:twords;
Procedure GetWords(s: string; var arr: TWords; var num:integer);
var
  i, p: integer;
begin
  while pos('  ', s) <> 0 do
    delete(s, pos('  ', s), 1);

  if s[1] = ' ' then delete(s, 1, 1);
  if s[length(s)] = ' ' then delete(s, length(s), 1);

  i := 1;
  repeat
    p := Pos(' ', s); inc(i);
    if p > 0 then begin
      arr[i] := copy(s, 1, pred(p)); delete(s, 1, p)
    end
    else arr[i] := s
  until p = 0;
  num:=i;
end;
begin
writeln('Vvedite tekst:');
readln(st);
getwords(st,a,n);
e:=0;
for k:=1 to n do begin
  for m:=1 to length(a[k]) do
    f:=0;
    for d:=1 to length(a[k]) do if a[k][m]=a[k][d] then inc(f);
    if f>=3 then begin
                  inc(e);
                  b[e]:=a[k];
                  end; end;
writeln;
writeln('Otobrannie slova:');
for k:=1 to e do writeln(b[k]);
readln;
end.

[GAA]

Внимательно не смотрел, но в основной части программы бросается в глаза следующее: цикл for m:=1 to length(a[k]) стоит внутри операторных скобок (в чем нет необходимости), а вот его тело в операторные скобки не помещено. Видимо должно быть так:

for k:=1 to n do
 for m:=1 to length(a[k]) do 
  begin
    f:=0; 
    for d:=1 to length(a[k]) do if a[k][m]=a[k][d] then inc(f); 
    if f>=3 then begin 
                  inc(e); 
                  b[e]:=a[k]; 
                 end;
  end;

Приведите пример проверки, которая не проходит. Я, конечно, говорю о проверке, которая не проходит после исправления опечатки.

[boloboshenku]

Нашел ошибку..

for k:=1 to n do begin
 f:=0;{Обнулять f надо здесь, а не там, где было!}
 for m:=1 to length(a[k]) do begin
    for d:=1 to length(a[k]) do if a[k][m]=a[k][d] then inc(f); end;
    if f>=3 then begin
                  inc(e);
                  b[e]:=a[k];
                 end; end;

[GAA]

boloboshenku писал(а):

Нашел ошибку..

for k:=1 to n do begin
 f:=0;{Обнулять f надо здесь, а не там, где было!}
 for m:=1 to length(a[k]) do begin
    for d:=1 to length(a[k]) do if a[k][m]=a[k][d] then inc(f); end;
    if f>=3 then begin
                  inc(e);
                  b[e]:=a[k];
                 end; end;

Это неправильно. Например, такая программа отберет из текста «tty» слово «tty» (как содержащее три буквы «t»), что, конечно, неверно.

Добавлено спустя 1 час 57 минут 42 секунды:

Если модифицировать так, как я указал выше, то программа будет повторять одно и то же (правильно) найденное слово (количество повторений равно количеству совпадающих букв в слове). Так, например, слово «ttttrrr» будет повторено семь раз.

Кстати, по смыслу, возвращаемое функцией GetWords значение переменной n, — это количество слов в тексте, однако на деле значение n на 1 больше, т.е. если ввести текс из одного слова, то GetWords вернет значение n равное 2. При этом первое слово в массиве a — это пустая строка (слово без единого символа).

Предложенный Вами алгоритм можно подправить путем добавления проверки «m<>d»

for k:=2 to n do
 begin
  f:=0;
  for m:=1 to length(a[k]) do
    for d:=1 to length(a[k]) do if (m<>d) and (a[k][m]=a[k][d]) then inc(f);
  if f>=3 then begin
                     inc(e);
                     b[e]:=a[k];
                   end;
 end; 

Массив по k, конечно, может начинаться и с 1 — на результат это не повлияет.

[boloboshenku]

Тоже неверно..слово из текста "aabbccdd" он тоже выдаст...

[GAA]

Да, сильно заврался.
На самом деле я бы поступил так. Завел бы массив флагов. Флаг k показывает, содержит ли слово k три одинаковые буквы. Двигаясь, как в первой моей модификации Вашей программы (f внутри цикла), поднимал бы флаг, если слово содержит три и более одинаковых буквы. При таком варианте и слова находим нужные, и повторений не будет.

[boloboshenku]

for k:=2 to n do begin
  m:=0;
  repeat
    inc(m);
    f:=0;
    for d:=1 to length(a[k]) do if (a[k][m]=a[k][d]) then inc(f)
  until (f=3) or (m=length(a[k]));
                     if f=3 then begin inc(e);
                     b[e]:=a[k];
                   end;
 end;

вот так подходит...спасибо;)

[GAA]

Да, так лучше, чем с массивом флагов.

[boloboshenku]

Спасибо!..

[GAA]

В блоке

  i := 1;
  repeat
    p := Pos(' ', s); inc(i);
    if p > 0 then begin
      arr[i] := copy(s, 1, pred(p)); delete(s, 1, p)
    end
    else arr[i] := s
  until p = 0;

я бы инициализировал i нулем, т.е.

i := 0;
 repeat
    p := Pos(' ', s); inc(i);
    if p > 0 then begin
      arr[i] := copy(s, 1, pred(p)); delete(s, 1, p)
    end
    else arr[i] := s
  until p = 0; 

Тогда значение n после выполнения процедуры было бы равно числу слов, и в a[1] не лежало бы пустое слово.
(Наконец-то нашел время внимательно прочитать текст программы)

[boloboshenku]

Ага.. я после этого Вашего замечания

GAA писал(а):

Кстати, по смыслу, возвращаемое функцией GetWords значение переменной n, — это количество слов в тексте, однако на деле значение n на 1 больше, т.е. если ввести текс из одного слова, то GetWords вернет значение n равное 2. При этом первое слово в массиве a — это пустая строка (слово без единого символа).

i нулем и инициализировал...Спасибо..