срочно нужна помощь, со строками Поскаль

[Dimon1231]

Дана строка символов S, состоящая из латинских букв. Группы символов, разделенные пробелами и не содержащие пробелов внутри себя, будем называть словами. Преобразовать исходную строку в строки S1 и S2 в соответствии с пунктами 1 и 2 задания. Если какая-либо из итоговых строк окажется пустой, выводить соответствующее сообщение.

Задание №1
п.1. - Напечатать слово, имеющее максимальную длину и отличное от последнего слова.
п.2. - Напечатать те слова последовательности, которые отличны от последнего слова, предварительно все вхождения abc заменив на def, если такие есть.

Сдесь ощибка, помогите исправить:
Программа глючит.
1. При вводе строки, состоящей из пробелов, программа зависает.
2. при вводе строки ff ff ff В начале строки и в конце строки пробелы.
программа выдает некорректный результат:
s1: f (неверно)
s2: пустая
program LAB_2;
const
abc='abc';
def='def';
var
s,p,p_s,s1,s2,s3,s4,s5,s6:string;
i,q,n,a,b,c,n1,y,n2,k,max,w,d,n3,n4 :byte;
slovo:boolean;
begin
writeln('stroka s');
readln(s);

slovo:=false;
p:=' ';

{Proverka stroki s na nachalo slova}
for i:=1 to length(s) do if (s[i]<>p)and(s[i-1]=p) then slovo:=true;


if slovo then q:=1;
while s[q]=p do delete(s,q,1);
q:=length(s);
while s[q]=p do begin
delete(s,q,1);
q:=q-1;
end;
{Videlenie iz stroki s poslednego slova p_s i stroki s3 ne soderdzachei
poslednego slova p_s}
s:=p+s;
n:=length(s);{Opredelenie dlini stroki}
for i:=1 to n do begin
if s[i]=p then begin
b:=n-i+1;{poslednee alement}
c:=n-b;
end;
p_s:=copy(s,a+1,b);
s3:=copy(s,1,c);
end;
{Polychenie stroki s4, ydalaia iz stroki s3 slovo p_s}
s4:=s3+' ';
while pos(p+p_s,s4)>0 do begin
n1:=length(p_s);
y:=pos(p+p_s,s4);
delete(s4,y,n1);
end;
{Videlenie slova max dlini s1 iz stroki s5}
s5:=s4;
n2:=length(s5);
i:=1;{Opredelenie parametra cikla}
max:=0;{max dlina slova}
while i<=n2 do {Cikl dla prosmotra vsei dlini}
begin
k:=0;{Dlina slova. Prisvoenie nachalenogo znachenia}
while (s5[i]<>p)and(i<=n2) do
begin
inc(k); {Vichislenie dlini slova}
inc(i); {Perexod k cledyechemy simvoly}
end;
if k>max then begin
max:=k;
w:=i;
end;
i:=i+1;
s1:=copy(s5,w-max,max);
end;
if max<>0 then writeln('s1=',s1)
else writeln('stroka S1 pysta');
{Polychenie stroki s6, iz stroki s, zameniv vxodzdenie abc na def}
s6:=s;
while pos(abc,s6)>0 do begin
n1:=length(abc);
n2:=length(def);
d:=pos(abc,s6);
delete(s6,d,n2);
insert(def,s6,d);
end;
{Opredelenia p_s, iz stroki s6, i polychenia stroki s3, ne soderdzachego p_s}
n3:=length(s6);

for i:=1 to n3 do begin
if s6[i]=p then begin
b:=n3-i+1;{posledni element}
c:=n3-b;
end;
p_s:=copy(s6,a+1,b);
s3:=copy(s6,1,c);
end;
{Polychenie stroki s2, pytem ydalenia iz stroki s3 p_s}
s2:=s3+p;
n4:=length(s3);
while pos(p+p_s,s2)>0 do begin
n1:=length(p_s);
y:=pos(p+p_s,s2);
delete(s2,y,n1+1);
end;
if s2=p then writeln('stroka S2 pysta')
else writeln('s2=',s2);

readln
end.

[alexBlack]

Мм..да..

По-моему, Вы недостаточно продумали алгоритм. Несмотря на то, что код почти работает, предлагаю переделать. Посмотрите сюда:

   // Делим строку на две части
   n := length(s);
   while (n >= 1) and (s[n] = ' ') do dec(n);   // Пропуск пробелов в конце строки
   n1 := n;
   while (n >= 1) and (s[n] <> ' ') do dec(n);  // Поиск пробела перед последним словом

   s3 := copy(s, 1, n-1);                       // строка без последнего слова
   p_s := copy(s, n+1, n1-n);                   // последнее слово
   writeln(p_s);

   // Дальше работаем только с первой частью без последнего слова
   s3 := s3 + ' ';  n := 1; k := 1;
   while n <= length(s3) do begin
      if s3[n] = ' ' then begin
         // Нашли очередной пробел
         if n-k > 1 then begin
            s1 := copy(s3, k, n-k);             // Очередное слово в строке
            writeln(s1);
            // ....
            // дальше решаем, что делать с этим словом
            // ...
         end;
         k := n+1;
      end;
      inc(n);
   end;

Это почти все решение. Дальше проверяем на равенство с последним, сравниваем длину (ищем максимальное). Здесь же меняем acd на def и формируем строку S2. Надеюсь, это поможет.

[Dimon1231]

сейчас работает нормально, если есть какие коментарии ответь

program LAB_2;
const
abc='abc';
def='def';
var
s,p_s,s1,s2,s3,s4,s5:string;
na,i,q,n,n1,y,n2,k,max,w,d:byte;
slovo:boolean;
begin
writeln('stroka s');
readln(s);

{Delim ctroky na 2 hacti}
n := length(s);
while (n >= 1) and (s[n] = ' ') do dec(n);
n1 := n;
while (n >= 1) and (s[n] <> ' ') do dec(n);
{Slovo s3 bez poslednego slova p_s}
s3 := copy(s, 1, n-1);
p_s := copy(s, n+1, n1-n);

{rabotaem s 1 hactie bez poslednego slova p_s}
s3 := s3 + ' '; n := 1; k := 1;
while n <= length(s3) do
begin
if s3[n] = ' ' then
begin
s4 := copy(s3, k, n-k);

{Videlenie slova max dlini s1 iz stroki s5}
s5:=' '+s4+' '+' ';
n2:=length(s5);
i:=1;{Opredelenie parametra cikla}
max:=0;{max dlina slova}
while i<=n2 do {Cikl dla prosmotra vsei dlini}
begin
k:=0;{Dlina slova. Prisvoenie nachalenogo znachenia}
while (s5[i]<>' ')and(i<=n2) do
begin
inc(k); {Vichislenie dlini slova}
inc(i); {Perexod k cledyechemy simvoly}
end;
if k>max then begin
max:=k;
w:=i;
end;
i:=i+1;
s1:=copy(s5,w-max,max);
end;


{Polychenie stroki s6, iz stroki s, zameniv vxodzdenie abc na def}
s2:=s3;
while pos(abc,s2)>0 do begin
na:=length(abc);

d:=pos(abc,s2);
delete(s2,d,na);
insert(def,s2,d);
end;
end;
inc(n);
end;
if max<>0 then writeln('s1=',s1)
else writeln('stroka S1 pysta');
if s2=' ' then writeln('stroka S2 pysta')
else writeln('s2=',s2);

readln
end.

[alexBlack]

s4 := copy(s3, k, n-k);
{Videlenie slova max dlini s1 iz stroki s5}
s5:=' '+s4+' '+' ';

s4 - это уже слово из строки. Зачем Вы опять добавляете в него пробелы и потом пытаетесь выделить слово еще раз.

-------------------------

...
s4 := copy(s3, k, n-k);   // Очередное слово строки
// Сразу сравниваем его с последним 
if s4 <> p_s then begin  
   // слово не равно последнему 
   // проверяем длину
   if length(s4) > max then begin
     s1 := s4;
     max := length(s4)
   end;
end;

// Слово s4 у нас никуда не делось
// заменяем adc на ... 
// Код замены у Вас есть 
// и добавляем в строку s2
s2 := s2 + ' '+s4
...

-------------------------------
Итого

var p:integer;
    s,p_s,s1,s2,s3,s4:string;
    n,n1,k,max:byte;
begin
   s:='hgjfkds   ghjfkds   abcfjabch hgabchf adfhsjk gshjk hgfhfhf ';

   // Делим строку на две части
   n := length(s);
   while (n >= 1) and (s[n] = ' ') do dec(n);   // Пропуск пробелов в конце строки
   n1 := n;
   while (n >= 1) and (s[n] <> ' ') do dec(n);  // Поиск пробела перед последним словом

   s3 := copy(s, 1, n);                         // строка без последнего слова
   p_s := copy(s, n+1, n1-n);                   // последнее слово
   writeln(p_s);

   // Дальше работаем только с первой частью без последнего слова
   n := 1; k := 1; max := 0; s1 := ''; s2 := '';
   while n <= length(s3) do begin
      if s3[n] = ' ' then begin
         // Нашли очередной пробел
         if n-k > 1 then begin
            s4 := copy(s3, k, n-k);             // Очередное слово в строке
            writeln(s1);
            // дальше решаем, что делать с этим словом
            if s4 <> p_s then begin             // Отличное от последнего
               if length(s4) > max then begin
                  s1 := s4;
                  max := length(s4)
               end;
            end;
            // Заменяем
            p := pos('abc', s4);
            while p <> 0 do begin
               delete(s4, p, 3);
               insert('def', s4, p);
               p := pos('abc', s4);
            end;
            if length(s2) > 0 then s2 := s2 + ' ';
            s2 := s2+s4;
         end;
         k := n+1;
      end;
      inc(n);
   end;
   // и уже здесь проверка на пустые строки
   //if length(s1) = 0 then ...
   writeln(s);
   writeln(s1);
   writeln(s2);
   readln;

Обратите внимание, как мало добавилось к коду, который я приводил вчера.

[Dimon1231]

не определяетс слово с одной буквой или в строке слов с одной буквой

program LAB_2;
var p:integer;
s,p_s,s1,s2,s3,s4:string;
n,n1,k,max:byte;
begin
writeln('stroka s');
readln(s);

{Делим строку на две части}
n := length(s);
while (n >= 1) and (s[n] = ' ') do dec(n); { Пропуск пробелов в конце строки}
n1 := n;
while (n >= 1) and (s[n] <> ' ') do dec(n); { Поиск пробела перед последним словом}

s3 := copy(s, 1, n); { строка без последнего слова}
p_s := copy(s, n+1, n1-n); { последнее слово}


{ Дальше работаем только с первой частью без последнего слова}
n := 1; k := 1; max := 0; s1 := ''; s2 := '';
while n <= length(s3) do begin
if s3[n] = ' ' then begin
{ Нашли очередной пробел}
if n-k > 1 then begin
s4 := copy(s3, k, n-k); {Очередное слово в строке}

{ дальше решаем, что делать с этим словом}
if s4 <> p_s then begin { Отличное от последнего}
if length(s4) > max then begin
s1 := s4;
max := length(s4)
end;
end;
{ Заменяем}
p := pos('abc', s4);
while p <> 0 do begin
delete(s4, p, 3);
insert('def', s4, p);
p := pos('abc', s4);
end;
if length(s2) > 0 then s2 := s2 + ' ';
s2 := s2+s4;
end;
k := n+1;
end;
inc(n);
end;

if max<>0 then writeln('s1=',s1)
else writeln('stroka S1 pysta');

if length(s2)=0 then writeln('stroka S2 pysta')
else writeln('s2=',s2);
readln;
end.

[alexBlack]

Измените условие:

if n-k > 0 then begin

в моем коде ошибка. Должен быть 0 вместо 1.

[Dimon1231]

при вводе ( g g g g )
s1 выводит строка пуста
и также если (ff ff ff )
s1строка пуста

[Alter]

Отделение слов, набросал:

uses crt;
var S,S0 :string; i,j,k :Integer;
    s1 :array[1..200] of String;
begin
 ClrScr;
 write('vvedite predlozhenie: '); readln(s);
  k := 0;
 if s<>'' then
 begin
   s0:='';
   j:=0;
  For i:=1 to length(s)+1 do
  begin
   IF not (s[i] in [' ', ',', '.']) and(I<=length(s)) then
     s0 := s0 + s[i]
    Else
   begin
    if S0<>'' then
    begin
     Inc( j );
     S1[j] := S0;
     S0:='';
     Inc( k );
    end;
   end;
  end;
 end;
  Writeln;
 For I:=1 To k Do
 Write(' [', S1[I], ']');

 readln;
end.

А затем можете с массивом работать!

[alexBlack]

Сообщение от Dimon1231

при вводе ( g g g g )
s1 выводит строка пуста
и также если (ff ff ff )
s1строка пуста

??? А что по Вашему должно быть ?
Задание еще не изменилось ? :

п.1. - Напечатать слово, имеющее максимальную длину и отличное от последнего слова.

[Dimon1231]

мне нужно чтобы выводилось
если (f f f ) то s1:=f ; а s2:=f f
если (abcabc a abc abc) то s1:=abcabc ; s2:=defdef a def
но выводит без а