fork download
copy 
  1. program Lab1_Variant23;
  2.  
  3. {$APPTYPE CONSOLE}
  4. {$MODE OBJFPC} { для Free Pascal, совместимость с Delphi }
  5.  
  6. uses
  7.   SysUtils;
  8.  
  9. const
  10.   AlphUp =
  11.     'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
  12.  
  13.   AlphLow =
  14.     'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
  15.  
  16.   SymbTable =
  17.     'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ' +
  18.     '0123456789' +
  19.     'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
  20.  
  21. const
  22.   Digits : set of Char = ['0'..'9'];
  23.  
  24. function IsUpperCyr(C: Char): Boolean;
  25. begin
  26.   IsUpperCyr := Pos(C, AlphUp) > 0;
  27. end;
  28.  
  29. function IsLowerCyr(C: Char): Boolean;
  30. begin
  31.   IsLowerCyr := Pos(C, AlphLow) > 0;
  32. end;
  33.  
  34. function Prov1(const S: String): Byte;
  35. var
  36.   i : Integer;
  37. begin
  38.  
  39.   if Length(S)=0 then
  40.   begin
  41.     Prov1:=1;
  42.     Exit;
  43.   end;
  44.  
  45.   for i:=1 to Length(S) do
  46.     if not ((S[i] in Digits) or
  47.             IsUpperCyr(S[i]) or
  48.             IsLowerCyr(S[i])) then
  49.     begin
  50.       Prov1:=2;
  51.       Exit;
  52.     end;
  53.  
  54.   Prov1:=0;
  55. end;
  56.  
  57. function Prov2(const S: String): Byte;
  58. var
  59.   i : Integer;
  60. begin
  61.  
  62.   if Length(S)=0 then
  63.   begin
  64.     Prov2:=1;
  65.     Exit;
  66.   end;
  67.  
  68.   for i:=1 to Length(S) do
  69.     if Pos(S[i], SymbTable)=0 then
  70.     begin
  71.       Prov2:=2;
  72.       Exit;
  73.     end;
  74.  
  75.   Prov2:=0;
  76. end;
  77.  
  78. procedure Sort1(var S: String);
  79. var
  80.   i,z,len : Integer;
  81.   flag : Boolean;
  82.   ch : Char;
  83. begin
  84.  
  85.   len:=Length(S);
  86.   z:=1;
  87.  
  88.   repeat
  89.  
  90.     flag:=True;
  91.  
  92.     for i:=1 to len-z do
  93.  
  94.       if
  95.  
  96.       ((S[i] in Digits) and IsUpperCyr(S[i+1]))
  97.  
  98.       or
  99.  
  100.       (IsLowerCyr(S[i]) and
  101.        (IsUpperCyr(S[i+1]) or
  102.         (S[i+1] in Digits)))
  103.  
  104.       or
  105.  
  106.       (IsUpperCyr(S[i]) and
  107.        IsUpperCyr(S[i+1]) and
  108.        (Pos(S[i],AlphUp) >
  109.         Pos(S[i+1],AlphUp)))
  110.  
  111.       then
  112.       begin
  113.         ch:=S[i];
  114.         S[i]:=S[i+1];
  115.         S[i+1]:=ch;
  116.         flag:=False;
  117.       end;
  118.  
  119.     Inc(z);
  120.  
  121.   until flag or (z=len);
  122.  
  123. end;
  124.  
  125. procedure Sort2(var S: String);
  126. var
  127.   i,z,len : Integer;
  128.   flag : Boolean;
  129.   ch : Char;
  130.   p1,p2 : Integer;
  131. begin
  132.  
  133.   len:=Length(S);
  134.   z:=1;
  135.  
  136.   repeat
  137.  
  138.     flag:=True;
  139.  
  140.     for i:=1 to len-z do
  141.     begin
  142.  
  143.       p1:=Pos(S[i],SymbTable);
  144.       p2:=Pos(S[i+1],SymbTable);
  145.  
  146.       if
  147.  
  148.       ((p1>33) and (p1<=43) and (p2<=33))
  149.  
  150.       or
  151.  
  152.       ((p1>=44) and (p2<=43))
  153.  
  154.       or
  155.  
  156.       (IsUpperCyr(S[i]) and
  157.        IsUpperCyr(S[i+1]) and
  158.        (Pos(S[i],AlphUp) >
  159.         Pos(S[i+1],AlphUp)))
  160.  
  161.       then
  162.       begin
  163.         ch:=S[i];
  164.         S[i]:=S[i+1];
  165.         S[i+1]:=ch;
  166.         flag:=False;
  167.       end;
  168.  
  169.     end;
  170.  
  171.     Inc(z);
  172.  
  173.   until flag or (z=len);
  174.  
  175. end;
  176.  
  177. var
  178.   S,S1,S2 : String;
  179.   Nom : Byte;
  180.  
  181. begin
  182.  
  183.   Write('Введите строку: ');
  184.   ReadLn(S);
  185.  
  186.   S1:=S;
  187.   S2:=S;
  188.  
  189.   Writeln;
  190.   Writeln('Исходная строка');
  191.   Writeln('"',S,'"');
  192.  
  193.   Writeln;
  194.   Writeln('Метод 1');
  195.  
  196.   Nom:=Prov1(S1);
  197.  
  198.   case Nom of
  199.  
  200.     1:
  201.       Writeln('Пустая строка');
  202.  
  203.     2:
  204.       Writeln('Некорректные символы');
  205.  
  206.   else
  207.     begin
  208.       Sort1(S1);
  209.       Writeln('Результат:');
  210.       Writeln('"',S1,'"');
  211.     end;
  212.  
  213.   end;
  214.  
  215.   Writeln;
  216.   Writeln('Метод 2');
  217.  
  218.   Nom:=Prov2(S2);
  219.  
  220.   case Nom of
  221.  
  222.     1:
  223.       Writeln('Пустая строка');
  224.  
  225.     2:
  226.       Writeln('Некорректные символы');
  227.  
  228.   else
  229.     begin
  230.       Sort2(S2);
  231.       Writeln('Результат:');
  232.       Writeln('"',S2,'"');
  233.     end;
  234.  
  235.   end;
  236.  
  237. end.
Success #stdin #stdout 0s 5316KB
comments (?)
stdin
copy 
12345
stdout
copy 
Введите строку: 
Исходная строка
"12345"

Метод 1
Результат:
"12345"

Метод 2
Результат:
"12345"
https://ideone.com/uaPpfc
language:
Pascal (fpc 3.0.4)
created:
16 hours ago
visibility:
public

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!