И снова строки, Удаление повторяющихся символов Опции

[mapblwka]

И снова проблема, и снова не могу никак решить, уже над этой задачи вторую неделю сижу и не могу закончить.

ЗАДАНИЕ: Дана последовательность, содержащая от 2 до 30 слов, в каждом из которых от 2 до 10 латинских букв; между соседними словами – не менее одного пробела, за последним словом – точка. Напечатать все слова, отличные от последнего слова, предварительно преобразовав каждое из них по следующему правилу:
Оставить в слове только первые вхождения каждой буквы.

С первым условием справились с горем пополам, использовав FAQ по строкам made by вами.
А вот второе.. НУ НИКАК! не удалеяет симоволы вот. Может это уже проблема многочасовго сидения за данной проблемой.

Код

program strochki;
uses crt;
type wmas=array[1..100] of string;
{mumumu - исходная строка
myp - последние слово
yry - строка из слов не совпадающих с последним словом не одним символом
xex - массив исходных слов
lol - массив слов не совпадающих с последним словом не одним символом
f - флажок для проверки первого совпадения символов
kyky - переменная для нахождения номера символа, с которого начинается найденная подстрока в строке.
i,j,k,l,q,c - различные счетчики, задействованные и нет.
y,z - вспомогательные строки}


{Процедура для вставки слов из строки в массив}
procedure GetWords(mumumu:string; var xex:wmas);
var i,j:shortint;
    mm:string;
begin
while pos('  ',mumumu)<>0 do delete(mumumu,pos('  ',mumumu),1);
if mumumu[1]=' ' then delete(mumumu,1,1);
if mumumu[length(mumumu)]=' ' then delete(mumumu,length(mumumu),1); {г¤ «Ґ­ЁҐ «Ёи­Ёе Їа®ЎҐ«®ў}
i:=1;
for j:=1 to length(mumumu) do
if mumumu[j]<>' ' then xex[i]:=xex[i]+mumumu[j] else if i<>high(xex) then inc(i); {§ Ї®«­пҐв ¬ ббЁў б«®ў ¬Ё Ё§ ба®ЄЁ}
end;

var mumumu,yry,myp,byrara,y,z:string;
    xex,lol:wmas;
    kyky,c:integer;
    i,k,q,j,l:shortint;
    f:boolean;

label bu;

    begin
clrscr;
writeln('Введите строку, разделяя слова пробелами, в конце поставьте точку.');
readln(mumumu);
byrara:=mumumu;

GetWords(byrara,xex);
k:=(length(mumumu)-1);
while mumumu[k]<>' ' do begin inc(i); dec(k); end;
myp:=copy(mumumu,k+1,i);
writeln('Последние слово: ', myp);

for k:=1 to high(xex) do begin

    f:=false;

 for l:=1 to length(myp) do begin
     kyky:=1;
     kyky:=pos(myp[l],xex[k]);
     if kyky=0 then f:=true;
     end;

    if f=true then yry:=yry + xex[k]+ ' ';

end;

writeln('Исключительные словав: ',yry);

{--------------------------------------------------}
GetWords(yry,lol);
for i:=1 to high(lol) do begin
    y:=lol[i];
    for k:=1 to length(y) do begin
 kyky:=pos(y[k],y);
 q:=length(y);
 z:=copy(y,kyky,q);
 kyky:=pos(y[k],z);
 if kyky<>0 then delete(y,kyky,1)
 end;
    end;
for j:=1 to high(lol) do
write(lol[j],' ');
readkey;
end.

НЕ РАБОТАЕТ: удаление повторяющихся символов в словах не совпадающих с последним словом, не одним символом. {последняя часть программы}

помогите... пожалуйста!!

Сообщение отредактировано: mapblwka - 30.11.2005 18:03

[Atos]

У нас остаются только одиночные пробелы. Ищем первый пробел(он показывает, где конец первого в данный момент слова в строке), удаляем это первое слово, скопировав его перед этим в массив слов. Повторяем это для строки, пока она не будет состоять из одного лишь последнего слова, тогда копируем строку в массив. При этом счётчиком i считаем количество слов.

[offtop] To: volvo, к слову, а почему pred(p) вместо простого р-1 Вообще, это будет как-то различаться по быстродействию?