Задача на строки Опции

[Liba]

Помогите пожалуйста решить задачку нам ее на контрольной дали,но ничего не получилось написать...............хотьь я и списала у одногрупника( и не я одна) он сказал вот вы у него списали я вам не засчитаю.....помогите плиз :molitva:
Задача такая:Задана строка,состоящая из слов латинского алфавита,разделенное одним или несколькими пробелами и знаками препинаниями(запетая,двоеточние,тире,точк, и т.д.)
Требуется:
1)выделить слоа из строки и сформулировать массив слов(максимальное количество строк n,а максимальное длина слов m;n=5.m=15).
2)Объединить в новую строку и в ней требуется найти подстроку неповторяющихся символов максимальной длины.
3)Найти набор символов, которые входят в каждые из нечетных слов,но е входят в состав найденый в предыдущем пункте подстроки.

Заранее вам огромное спасибо!!!!!!!!!
Решите пожалуйста очень надо в понедельник сдать ;)

[volvo]

Liba
Сама просила... (одно замечание - эта программа работает только со строчными буквами. Если нужна работа и с заглавными - говори, я исправлю)

Код

Type TWords = Array[1 .. 5] Of String[15];

Function GetWords(s: String; Var mas: TWords): Byte;
 Var
   i, j, p: Byte;
 Const
   Other = [',', '.', '-', ':', ';'];
 Begin
   For i := 1 To Length(s) Do
     If s[i] In Other Then s[i] := ' ';

   Repeat
     p := Pos('  ', s);
     If p > 0 Then Delete(s, p, 1)
   Until p = 0;

   If s[1] = ' ' Then Delete(s, 1, 1);
   If s[Length(s)] = ' ' Then
     Delete(s, Length(s), 1);

   i := 0;
   Repeat
     p := Pos(' ', s); Inc(i);
     If p > 0 Then
       Begin
         mas[i] := Copy(s, 1, Pred(p)); Delete(s, 1, p)
       End
     Else mas[i] := s
   Until p = 0;
   GetWords := i
 End;

Const
 s: String = 'this is just a test';

Var
 s2: String;
 i, Count: Byte;
 arr: TWords;

Var
 Ch: Char;
 InWord, InAll, Exists: Set Of Char;
 j, start, cnt, max_cnt: Byte;
Begin
 { Part 1 }
 Count := GetWords(s, arr);

 { Part 2 }
 s2 := '';
 For i := 1 to Count Do
   s2 := s2 + arr[i];

 max_cnt := 0;
 For i := 1 To Length(s2) - 1 Do
   Begin
     Exists := [];
     j := i; cnt := 0;
     While (j <= Length(s2)) and (not (s2[j] In Exists)) Do
       Begin
         Exists := Exists + [s2[j]];
         Inc(j); Inc(cnt)
       End;

     If max_cnt < cnt Then
       Begin
         max_cnt := cnt; start := i;
       End;
   End;

 { Part 3 }
 Exists := [];
 For i := 0 to Pred(max_cnt) Do
   Exists := Exists + [s2[start + i]];

 {**** Добавлено для работы с заглавными буквами *****}
 InAll := ['a' .. 'z', 'A' .. 'Z'];

 i := 1;
 While i <= Count Do
   Begin
     InWord := [];
     For j := 1 To Length(arr[i]) Do
       InWord := InWord + [arr[i][j]];
     InAll := InAll * InWord;
     Inc(i, 2)
   End;

 Exists := Exists - InAll;
 For Ch := 'a' To 'z' Do
   If Ch In Exists Then Write(Ch, ' ');
 WriteLn;

End.

Liba, теперь программа должна работать и с заглавными тоже...

Сообщение отредактировано: volvo - 4.12.2004 12:05