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