Строковые, слова одинаковой длины Опции

[Кристина]

Привет! Как всегда помогите с задачей на строковые:
Определить количество слов в строке, есть ли одинаковой длины сколько и какие.
Если количеством строк все просто, то с длиной сложнее. Помогите хотя бы советом, хотя лучше прогу!
Заранее спасибо!!!

[BlackShadow]

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

[BlackShadow]

Код

Var
 s:String;
 i,j,k,n,len:Integer;
 Words:Array[1..100] Of String;

Const
 Separators = [' ',',','.','!','?']; {Дополнить по желанию}

Begin
 ReadLn(s);
 n:=1;
 i:=1;
 While i<Length(s) Do
 Begin
   While (i<Length(s)) And (s[i] In Separators) Do
     Inc(i);
   If Length(s)<i Then
     Break;
   j:=i;
   While (j<Length(s)) And (s[j] In Separators) Do
     Inc(j);
   i:=j;
   Words[n]:=Copy(s,i,j-i);
   Inc(n)
 End;
 WriteLn('Total ',n,' words.');
 If n=0 Then
   Halt;
 For i:=1 To n-1 Do
 Begin
   Len:=Length(Words[i]);
   k:=i;
   For j:=i+1 To n Do
     If Length(Words[j])<Len Then
     Begin
       Len:=Length(Words[j]);
       k:=j
     End;
     If k<>i Then
     Begin
       s:=Words[i];
       Words[i]:=Words[k];
       Words[k]:=s
     End
 End;
 i:=1;
 While i<n Do
 Begin
   j:=i+1;
   While (j<n) And (Length(Words[j])=Length(Words[i])) Do
   Begin
     WriteLn(Words[j]);
     Inc(j)
   End;
   If j<>i+1 Then
   Begin
     WriteLn(Words[i]);
     WriteLn('-----------');
     WriteLn('Words Of Length ',Length(Words[i]))
   End;
   i:=j
 End
End.

Должно быть что-то похожее...
К сожалению проверить не могу, т. к. Pascal'я под рукой нет.

Решение примерно следующее:
1). Вводим строку.
2). Разбираем её на слова и сохраняем их в Words, а их кол-во в n.
3). Сортируем Words по длине строк. Пузырьком, чтоб не париться
4). Выводим строки одинаковой длины:
а). Берём очередную строку.
б). Рассматриваем все последующие.
в). Если длины строк совпадают, то переходим к следующей, иначе прерываем перебор.
г). Если нашлась ещё хоть одна строка такой длины, то выводим текущую строку на экран, а затем и длину всех этих строк. Прости за туфтологию :D

Вот и всё.

[Кристина]

Спасибо за программу! Вопрос: а можно сделать то же самое но без массива?

[BlackShadow]

а тебя, что списки больше прикалывют?

[trminator]

Можно и без массива. Пройти по строке, при этом начало и конец слова выделяются просто. Конец слова -- это когда шли по строке и встречали буквы (слово, то бишь), и вдруг встретили [пробел, запятую, точку, двоеточие, запяточку, ..., далее -- .,: ;]. Начало слова, соответственно, наоборот.

То есть идем по строке,если встретили [.,: ;] (далее -- разделитель),помечаем, что мы -- в слове и начинаем считать символы после этого. Когда встретили следующий разделитель, смотрим, что насчитали. Можно это куда-нибудь сохранить (нет, сохранять все-таки в массив надо будет =).

Правда, при таком подходе может получиться слово нулевой длины -- это значит, что коварный препод ввел в строке два разделителя подряд... или три... как я, например, ввожу многоточия =) Слова нулевой длины без особого вреда для здоровья можно игнорировать.

ЗЫ Когда снова буду в инете -- не гарантирую =/ так что программа запоздает (если вообще будет=)

[trminator]

Код

program words;
const letters=['a'..'z'];
var s : string;
   keys : array[0..5, 0..255] of byte;
   i, l, n : integer;
begin
   Write('Enter string > '); readLn(s);
   i := 1; n := length(s);
   while i <= n do
   begin l := 0;
       while not (s[i] in letters) and (i <= n) do inc(i);
       while (s[i] in letters) and (i <= n) do
       begin
           inc(l);
           inc(i)
       end;
       inc(keys[0, l]); keys[keys[0, l], l] := i - l;
   end;

   for i := 1 to 255 do
       if keys[0,i] > 1 then
          writeLn(keys[0,i], ' words with length ', i);

   ReadLn;
end.

Вроде работает... В массиве keys в i-м столбце -- номера букв, с которых начинаются слова длины i, в нулевой строке -- количество слов длины i.

Можно довольно просто дописАть пару-тройку строк, чтобы выдавались и сами слова с одинаковым кол-вом символов