fork download
copy 
  1.   program main;
  2.  
  3.   type TByte=array[0..9] of Byte;
  4.   type TArray=array[1..10000] of Integer;
  5.  
  6.   {Заполняет массив значениями value}
  7.   procedure FillArray(A:TByte; size:Integer; value:Integer);
  8.   var i:Integer;
  9.   begin
  10.     for i:=1 to size do
  11.       A[i]:=value;
  12.   end;
  13.  
  14.   function product(a:Integer):Integer;
  15.    var p:LongInt;
  16.    begin
  17.     p:=1;
  18.     while a>0 do begin
  19.       p:=p*(a mod 10);
  20.       a:=a div 10;
  21.     end;
  22.     product:=p;
  23.   end;
  24.   {Тестирует число по условию задачи.
  25.   0 - все цифры разные (удалить число), 1 - есть одинаковые (пропустить), 
  26.   2 - дублировать. Каждый элемент массива index[0..9] содержит количество 
  27.   соответствующих цифр в числе, например index[3]=5 - в числе пять троек}
  28.   function TestNumber(n:Integer):Integer;
  29.   var index:TByte;
  30.       status:Byte;
  31.       i,a:Integer;
  32.   begin
  33.     status:=0;
  34.     TestNumber:=status;
  35.     FillArray(index,High(index)-Low(index),0);
  36.     a:=n; {Сохраним значение n}
  37.     while n>0 do
  38.       begin
  39.         inc(index[n mod 10]);
  40.         n:=n div 10;
  41.       end;
  42.     for i:=0 to 9 do
  43.       if index[i]>1 then
  44.         begin
  45.           status:=1;
  46.           TestNumber:=status;
  47.           break;
  48.         end;
  49.     if (status=0) then exit;
  50.     if (product(a) mod 14)=0 then
  51.       TestNumber:=2;
  52.   end;
  53.  
  54.   {Удаление числа из массива}
  55.   procedure delete(var A:TArray; var n:Integer);
  56.   var k,m:Integer;
  57.   begin
  58.     k:=1;
  59.     while k<=n do
  60.       if TestNumber(A[k])=0 then
  61.         begin
  62.           for m:=k to n-1 do
  63.             A[m]:=A[m+1];
  64.           n:=n-1;
  65.         end
  66.        else
  67.         k:=k+1;
  68.   end;
  69.  
  70.   procedure DreadMagic(var A:TArray; var B:TArray; var n:Integer);
  71.   var k,i:Integer;
  72.   begin
  73.     k:=0;
  74.     for i:=1 to n do
  75.     case TestNumber(A[i]) of
  76.       0: ; {do nothing}
  77.       1: begin
  78.             k:=k+1;
  79.             B[k]:=A[i];
  80.          end;
  81.       2: begin
  82.             k:=k+1; B[k]:=A[i];
  83.             k:=k+1; B[k]:=A[i];
  84.          end;
  85.     end;
  86.     n:=k;
  87.   end;
  88.  
  89.   procedure Input(var A:TArray; var n:Integer);
  90.   var i:Integer;
  91.   begin
  92.     write('Enter n: ');
  93.     read(n);
  94.     writeln('Enter ',n, ' elements:');
  95.     for i:=1 to n do
  96.       read(A[i]);
  97.   end;
  98.  
  99.   procedure Output(A:TArray; n:Integer);
  100.   var i:Integer;
  101.   begin
  102.     for i:=1 to n do
  103.       write(A[i]:6);
  104.   end;
  105.  
  106.   const T:array[1..7] of Integer=(987,4562,1123,31234,32368,876,1172);
  107.   var A:TArray;
  108.       B:TArray;
  109.       i,n:Integer;
  110.   begin
  111.     n:=7;
  112.     for i:=1 to n do begin
  113.       A[i]:=T[i];
  114.     end;
  115.     {Input(A,n);}
  116.     DreadMagic(A,B,n);
  117.     Output(B,n);
  118.   end.
Success #stdin #stdout 0.02s 296KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
   987   987  4562  1123 31234 32368   876   876  1172  1172
https://ideone.com/LAxTYY
language:
Pascal (fpc 3.0.4)
created:
11 years 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!