Удаление повторного вхождения букв

[Gasphord]

Удаление повторного вхождения букв

Напечатайте заданный текст из 15 литер, удалив из него повторные вхождения каждой литеры, т.е. (Привет,а как у тебя дела)->(Привет,а к у бя дл)
Как это реализовать ? Помогите пожалуйста.

Const n=15;
  Var a:array['a'..'z'] of integer;
  S:array[1..n] of char;
  i,j:integer;
  c:char;
begin
for i := 1 to n do
Read (S[i]);
for c:='a' to 'z' do
a[c]:=0;
for i:=1 to n do
a[s[i]]:=a[s[i]]+1;
for i := 1 to n do
if a[s[i]]=1 then  write(s[i]);
read(i);
end.

 

[Vladimir_S]

Как это реализовать ?

Проще всего — через множества. Например, так (сделано только для латиницы; с кириллицей тоже так можно, но нужно знать, какая кодовая таблица используется: их чертова прорва):

Var
 A:set of Char;
 S,S1:String;
 i:Integer;

Function Letter(C:Char):Boolean;
begin
 Letter:=((Ord(C)>64) and (Ord(C)<91)) or ((Ord(C)>96) and (Ord(C)<123));
end;

Begin
 A:=[];
 Writeln('Enter the string:');
 Readln(S);
 S1:='';
 for i:=1 to Length(S) do
  begin
   if Not(Letter(S[i])) then S1:=S1+S[i]
   else
   if Letter(S[i]) and Not(S[i] in A) then
    begin
     A:=A+[S[i]];
     S1:=S1+S[i];
    end;
  end;
 Writeln(S1);
 Readln
End.

 

[Евгений]

uses Crt;
type TSet=set of char;
var s,s1:string;
    c:char;
    St:TSet;
    i:byte;
begin
  ClrScr;
   Writeln('Stroka is 15 simvolov:');
    Writeln;
     Readln(s);
      Writeln;
   St:=[]; s1:=''; i:=1;
    repeat
      c:=s[i];
      if c in [',','.',' ','!','?','-',':',';']
       then
        begin
         Inc(i); s1:=s1+c;
        end
       else
        if c in St
         then Inc(i)
         else
          begin
            s1:=s1+c; St:=St+[c]; Inc(i);
          end;
    until i>Length(s);
   Writeln(s1);
  Readkey;
end.

 

[Vladimir_S]

Можно, кстати, и проще (я про свою программу), без функции. Кроме того, подключена и кириллица (Windows-кодировка):

Const
 Letter=['a'..'z','A'..'Z','а'..'я','А'..'Я'];

Var
 A:set of Char;
 S,S1:String;
 i:Integer;

Begin
 A:=[];
 Writeln('Enter the string:');
 Readln(S);
 S1:='';
 for i:=1 to Length(S) do
  begin
   if Not(S[i] in Letter) then S1:=S1+S[i]
   else
   if Not(S[i] in A) then
    begin
     A:=A+[S[i]];
     S1:=S1+S[i];
    end;
  end;
 Writeln(S1);
 Readln
End.