Паскаль. Удаление из слов предыдущие вхождения в него последней буквы.

[Svetik2252]

Здравствуйте.

Дана строка, состоящая из латинских символов. Символы, разделенные пробелами, будем называть слова.

Напечатать слова, отличные от последнего слова, удалив из них все предыдущие вхождения последней буквы.

Мой код почему-то не работает, хотя вроде бы и все правильно, нужна помощь в нахождении ошибки в коде...

uses crt;
var s:string;
v:string[1];
i,j:byte;
begin
clrscr;
write('Введите строку');
readln(s);
i:=length(s);
repeat
if copy(s,i,1)<>' ' then
begin
v:=copy(s,i,1);
j:=i-1;
while (j>=1) and (copy(s,j,1)<>' ') do
begin
if copy(s,j,1)=v then begin
delete(s, j, 1);
inc(j);
end;
dec(j);
end;
i:=j;
end;

dec(i);
until i<1;
writeln(s);
readln;
end.

[AlexanderKs]

Вам нужно чтобы на запрос "Chem dalshe v les tem bolshe drov" программа выдала "Chem dalse v ls t bolh dro"? Такая логика?

[AlexanderKs]

Если да, то вот код.

uses Crt;
var
  s,slovo:string;
  i,j:integer;
begin
Readln(s);
     {ищем и удаляем последнее слово...}
for i:=1 to Length(s) do
  if (s[i]=' ') and (s[i+1] in ['a'..'z','A'..'Z']) then j:=i;
for i:=j to length(s) do
  if (s[i] in ['a'..'z','A'..'Z']) then slovo:=slovo+s[i];
j:=1;
while j>0 do begin
  j:=pos(slovo,s);
  if j>0 then
    Delete(s,j,Length(slovo));
end;
     {слово удалили, ищем и удаляем символы}
i:=1;
while i<=Length(s) do begin
  if (s[i]=' ') and (s[i-1]<>' ') then begin
    j:=i;
    while j<Length(s) do begin
      if s[j]=s[i-1] then
        Delete(s,j,1);
      inc(j);
    end;
  end;
inc(i);
end;

Writeln(s);

Readln;
end.

[Svetik2252]

Мне нужно чтобы она выдала вместо:
bjkblb ahjkh okhl
jklb ajkh okhl
то есть нашла в слове последнюю букву, и если такие же буквы есть в этом же слове, то удалила их...

[AlexanderKs]

Если хотите получить более менее подходящий ответ, правильно ставьте вопрос.

uses Crt;
var
  s,slovo:string;
  i,j:integer;
  buf:char;
begin
Readln(s);
     {ищем последнее слово}
for i:=1 to Length(s) do
  if (s[i]=' ') and (s[i+1] in ['a'..'z','A'..'Z']) then j:=i;
for i:=j to length(s) do
  if (s[i] in ['a'..'z','A'..'Z']) then slovo:=slovo+s[i];
    {ищем и удаляем символы}
i:=1;
while i<=Length(s) do begin
  if (s[i]=' ') and (s[i-1]<>' ') then begin
    j:=i-2;
    buf:=s[i-1];
    if copy(s,j-Length(s),Length(s))<>slovo then begin
       while s[j]<>' ' do begin
         if s[j]=buf then
           Delete(s,j,1);
         dec(j);
       end;
    end;
  end;
inc(i);
end;

Writeln(s);

Readln;
end.

[Alex_FF]

решение задачи:

const
  Alphabet = ['A'..'Z', 'a'..'z'];

function ModifiedWord(Word: String): String;
var
  LastLetter: Char;
  S: String;
  I: Integer;
begin
  LastLetter := Word[Length(Word)];  { последняя буква }
  S := '';
  for I := 1 to Length(Word) - 1 do
    if Word[I] <> LastLetter then S := S + Word[I];
  S := S + LastLetter;
  ModifiedWord := S;
end;

var
  I, N: Integer;
  S, Word, LastWord: String;
begin
  ReadLn(S);
  { находим последнее слово }
  LastWord := '';
  I := Length(S);
  while (S[I] in Alphabet) and (I >= 1) do
  begin
    LastWord := Concat(S[I], LastWord);
    Dec(I);
  end;
  { найдено }
  I := 1;
  while I <= Length(S) - Length(LastWord) do
  begin
    if S[I] in Alphabet then
    begin
      Word := '';
      while (S[I] in Alphabet) and (I <= Length(S)) do
      begin
        Word := Word + S[I];
        Inc(I);
      end;
      if Word <> LastWord then Write(ModifiedWord(Word), ' ');
    end;
    Inc(I);
  end;
  Write(LastWord);
  ReadLn;
  ReadLn;
end.

[Alex_FF]

Мой код почему-то не работает, хотя вроде бы и все правильно, нужна помощь в нахождении ошибки в коде...

ошибка не в коде - ошибка - ваш код