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

[Liba]

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

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

[volvo]

Liba

ПРАВИЛА РАЗДЕЛА!!!
4. Прежде чем задавать вопрос, см. "FAQ",если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!

Здесь - последний пост

[Liba]

Я уже помоему весь форум прочитала аж глазки болят((((( :p2:
но я не вижу как это решать.........одно дело там написано друге дело это у меня должно быть както в программе

[volvo]

Ну и для кого делается ФАК? По ссылке лежит функция, которая разбивает строку на слова и заносит слова в массив. Что же, теперь для каждого задания переписывать эту функцию заново?

[Liba]

Не учто вся функция решает всю программу????

[volvo]

:no: Только первый пункт... Но если не будет первого, не будет и второго...

[Liba]

Я тебя прошу ты же знаешь как писать эту прогу.....
что тебе стоит скопировать эту функцию и дописать оставшиеся 2 пункта........я знаю они маленткие.....но как делать не знаю.......
темболее мне не разобраться с этим.....а если т мне расскажешь как попроще это делать я вообще буду на седьмом небе.. :p2: :flowers:

[volvo]

2)Объединить в новую строку и в ней требуется найти подстроку неповторяющихся символов максимальной длины.

то есть записать все слова слитно, без пробелов ?

[Liba]

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

[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

[Liba]

Спасибочки!!!!!!!!!! :flowers:
Но все равно исправь чтобы было для всего.....))))

[Liba]

А еще не мог бы ты условно поставить где 1,где 2,где 3.... :p2:

[volvo]

Liba
Там же стоит - Part 1, Part 2, Part 3 ...

[Liba]

ААА я просто не заметила!!!!!!!!!!огромное тебе спасибо!!!!!!!!!!!!ты просто бог :molitva: :rose:
А у тебя есть ICQ???

[volvo]

Liba
Зарегистрируйся на форуме, и получишь доступ к моему профилю... Там есть номер.

[Liba]

Ок...псибки

[Liba]

Скажи пожалуйста как избавится здесь от ошибки про которую я тебе говорила???
Я через делфи запускаю... :p2:

[volvo]

Liba
Я только что прогнал программу в Дельфи:

Код

program Project3;

{$APPTYPE CONSOLE}

uses
 SysUtils;

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;

{ TODO -oUser -cConsole Main : Insert code here }

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;
Readln

end.

Никаких ошибок...

[Liba]

теперь нету спасибо)))) :flowers: