fork download
copy 
  1. program ideone;
  2. {$mode delphi}
  3. uses SysUtils, Math;
  4.  
  5. type
  6.   TLongWordArr = array of longword;
  7.   TCallFunc = function(constref arr:TLongWordArr): longword;
  8.  
  9. function ArrNzItCnt(constref arr:TLongWordArr): longword;
  10. var
  11.   i: integer;
  12. begin
  13.   Result:=0;
  14.   for i:=0 to Length(arr)-1 do
  15.     if arr[i]<>0 then
  16.       Inc(Result);
  17. end;
  18.  
  19. const   
  20.   MAXDWORD = $FFFFFFFF;  
  21.  
  22. function ArrNzItCnt2(constref arr:TLongWordArr): longword;
  23. var
  24.   n,m: longword;
  25.   i  : integer;
  26. begin
  27.   Result:=0;
  28.   n     :=1+Trunc(ln(Double(MAXDWORD))/ln(2)); 
  29.   m     :=1<<n-1;
  30.   for i:=0 to Length(arr)-1 do
  31.     Inc(Result,(arr[i]+m)>>n);
  32. end;
  33.  
  34. function ArrNzItCntBoolcast(constref arr:TLongWordArr): longword;
  35. var
  36.   i: integer;
  37. begin
  38.   Result:=0;
  39.   for i:=0 to Length(arr)-1 do
  40.     Inc(Result, Ord(arr[i]<>0));
  41. end;
  42.  
  43. const
  44.   TestSize = 10000000;
  45.   func_call : array [0..2] of record 
  46.                  name : string;
  47.                  func : TCallFunc; 
  48.               end = ( 
  49.                 (name:'Normal'; func: ArrNzItCnt )
  50.                ,(name:'Math'; func: ArrNzItCnt2 )
  51.                ,(name:'Boolcast'; func: ArrNzItCntBoolcast )
  52.                // add more functions here, if needed
  53.               );
  54. var
  55.   t : Int64;
  56.   i, j : integer;
  57.   arr_test: TLongWordArr;
  58.   ArrCnt : TCallFunc;
  59.   nm : string;
  60. begin
  61. 	(* your code goes here *)
  62.  
  63.   SetLength(arr_test,TestSize);
  64.  
  65.   for j := low(func_call) to high(func_call) do 
  66.   begin
  67.  
  68.  	ArrCnt := func_call[j].func;
  69.  	nm := func_call[j].name;
  70.  
  71.     for i:=0 to length(arr_test)-1 do arr_test[i]:=0;
  72.     t:=GetTickCount64;	
  73.     ArrCnt(arr_test);
  74.     t:=GetTickCount64-t;
  75.     writeln(nm,' Test 1: ', t,'ms');
  76.  
  77.     for i:=0 to length(arr_test)-1 do arr_test[i]:=1;
  78.     t:=GetTickCount64;	
  79.     ArrCnt(arr_test);
  80.     t:=GetTickCount64-t;
  81.     writeln(nm,' Test 2: ', t,'ms');
  82.  
  83.     for i:=0 to length(arr_test)-1 do arr_test[i]:=Random(2);  
  84.     t:=GetTickCount64;	
  85.     ArrCnt(arr_test);
  86.     t:=GetTickCount64-t;
  87.     writeln(nm,' Test 3: ', t,'ms');
  88.  
  89.     for i:=0 to length(arr_test) div 2 -1 do
  90.       arr_test[2*i+0]:=1;
  91.     for i:=0 to length(arr_test) div 2 -1 do
  92.       arr_test[2*i+1]:=0;
  93.     t:=GetTickCount64;	
  94.     ArrCnt(arr_test);
  95.     t:=GetTickCount64-t;
  96.     writeln(nm,' Test 4: ', t,'ms');
  97.  
  98.     for i:=0 to length(arr_test) div 2-1 do
  99.       arr_test[2*i+0]:=0;
  100.     for i:=0 to length(arr_test) div 2-1 do
  101.       arr_test[2*i+1]:=1;
  102.     t:=GetTickCount64;	
  103.     ArrCnt(arr_test);
  104.     t:=GetTickCount64-t;
  105.     writeln(nm,' Test 5: ', t,'ms');    
  106.   end;
  107. end.
Success #stdin #stdout 0.49s 39456KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Normal Test 1: 6ms
Normal Test 2: 8ms
Normal Test 3: 43ms
Normal Test 4: 7ms
Normal Test 5: 8ms
Math Test 1: 11ms
Math Test 2: 12ms
Math Test 3: 11ms
Math Test 4: 11ms
Math Test 5: 11ms
Boolcast Test 1: 8ms
Boolcast Test 2: 9ms
Boolcast Test 3: 8ms
Boolcast Test 4: 8ms
Boolcast Test 5: 8ms
https://ideone.com/DJ9zlP
language:
Pascal (fpc 3.0.4)
created:
2 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!