Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 11.11.2019, 13:51   #1 (permalink)
Gasphord
Новичок
 
Регистрация: 15.10.2019
Сообщений: 9
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Post Удаление повторного вхождения букв

Напечатайте заданный текст из 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.
Gasphord вне форума   Ответить с цитированием

Старый 11.11.2019, 13:51
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Наверняка проблему уже разрешили ранее, поищите здесь

Функция повторного набора последнего исходящего вызова на многоканальном телефоне
Компьютер выключился,после повторного запуска выключается.заранее спасибо!
После отключения и повторного включения жёсткого диска SATA, он определяется как RAW
Вместо букв точки

Старый 11.11.2019, 15:07   #2 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,761
Сказал(а) спасибо: 339
Поблагодарили 579 раз(а) в 207 сообщениях
Репутация: 112176
По умолчанию

Цитата:
Сообщение от Gasphord Посмотреть сообщение
Как это реализовать ?
Проще всего — через множества. Например, так (сделано только для латиницы; с кириллицей тоже так можно, но нужно знать, какая кодовая таблица используется: их чертова прорва):
Код:
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.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Старый 11.11.2019, 15:18   #3 (permalink)
Евгений
Member
 
Аватар для Евгений
 
Регистрация: 31.03.2010
Адрес: Тульская область
Сообщений: 1,279
Сказал(а) спасибо: 11
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 12470
По умолчанию

Код:
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.
Евгений вне форума   Ответить с цитированием
Старый 11.11.2019, 16:27   #4 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,761
Сказал(а) спасибо: 339
Поблагодарили 579 раз(а) в 207 сообщениях
Репутация: 112176
По умолчанию

Можно, кстати, и проще (я про свою программу), без функции. Кроме того, подключена и кириллица (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.
Миниатюры
aa01.jpg  
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 15:31.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.