fork download
copy 
  1. // Выводит символы и пары символов, входящие в строку
  2. // К вопросу otvet.mail.ru/question/182440175
  3. // Copyleft Alexey Kuzminov 2015
  4. program question182440175;
  5.  
  6. type
  7.   SymbolList = String; // Перечень символов, поддерживает размер (Length) и оператор []
  8.  
  9. // добавляет символ в список, возвращая признак того, он что уже был
  10. function AddSymbol(var list: SymbolList; c: Char): Boolean;
  11. var
  12.   p: Integer;
  13. begin
  14.   p := Pos(c, list);
  15.   AddSymbol := p > 0;
  16.   if not AddSymbol then list := list + c;
  17.   // если AddSymbol = True, то можно передвинуть list[pos] к началу на символ,
  18.   // чтобы в следующий раз он быстрее нашелся
  19. end;
  20.  
  21. // Обрабатывает строку символов.
  22. // Выводит:
  23. // - перечень символов, в нее входящих
  24. // - перечень пар, которые в неё входят
  25. procedure Process(const s: String);
  26. var
  27.   symbols: SymbolList; // перечень символов строки
  28.   pair: array[char] of SymbolList; // массив пар символов (ab = pair[a] contains b)
  29. var
  30.   i: Integer;
  31.   c: Char;
  32.   first: Boolean;
  33. begin
  34.   // инициализация списка пустотой
  35.   symbols := ''; 
  36.   for c := Low(pair) to High(pair) do
  37.     pair[c] := '';
  38.  
  39.   WriteLn('{', s, '}');
  40.  
  41.   // случай пустой строки рассмотрим отдельно
  42.   if Length(s) = 0 then begin
  43.     WriteLn('   no chars');
  44.     Exit;
  45.   end;
  46.  
  47.   // первый символ добавим вручную
  48.   AddSymbol(symbols, s[1]);
  49.   // начнем итерацию со второго символа
  50.   for i := 2 to Length(s) do begin
  51.     AddSymbol(symbols, s[i]);
  52.     first := not AddSymbol(pair[s[i-1]], s[i]);
  53.     // можно анализировать признак того, что пара s[i-1]s[i] ещё не была в строке
  54.   end;
  55.  
  56.   // вывод символов строки
  57.   Write('   [');
  58.   for i := 1 to Length(symbols)-1 do
  59.     Write('''', symbols[i], ''', ');
  60.   WriteLn('''', symbols[Length(symbols)], ''']');
  61.  
  62.   // вывод пар символов
  63.   Write('   [');
  64.   first := True;
  65.   for c := Low(pair) to High(pair) do if Length(pair) > 0 then 
  66.     for i := 1 to Length(pair[c]) do begin
  67.       // перед первой парой символов не выводим ', '
  68.       if not first then Write(', ') else first := False;
  69.       Write('''', c, pair[c][i], '''');
  70.   	end;
  71.   WriteLn(']');
  72. end;  
  73.  
  74. begin
  75.   Process('');
  76.   Process('a');
  77.   Process('aaaa');
  78.   Process('ababa');
  79.   Process('abbbaaababaa');
  80.   Process('abbbaaababaca');
  81. end.
Success #stdin #stdout 0s 276KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
{}
   no chars
{a}
   ['a']
   []
{aaaa}
   ['a']
   ['aa']
{ababa}
   ['a', 'b']
   ['ab', 'ba']
{abbbaaababaa}
   ['a', 'b']
   ['ab', 'aa', 'bb', 'ba']
{abbbaaababaca}
   ['a', 'b', 'c']
   ['ab', 'aa', 'ac', 'bb', 'ba', 'ca']
https://ideone.com/0iyfuA
символы и пары символов, входящие в строку
language:
Pascal (fpc 3.0.4)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!