fork download
copy 
  1. program cupido;
  2.  
  3. const
  4.     MAXN = 100000;
  5. type elenco=Array[0..MAXN-1] of LongInt;
  6. var
  7.     K, N, i , amico    : LongInt;
  8.     A, B, C, ID : elenco;
  9.  
  10. Procedure scambia (var a,b: LongInt);
  11. var x:LongInt;
  12. begin
  13.    x:=a;
  14.    a:=b;
  15.    b:=x;
  16. end;  
  17. Procedure ordinamento (estremoi,estremos: LongInt; var v : elenco;var u : elenco;var w : elenco;var z : elenco; ordinato:boolean);
  18. var inf, sup, medio:LongInt;
  19.     pivot :LongInt;
  20. begin
  21.     inf:=estremoi;
  22.     sup:=estremos;
  23.     medio:= (estremoi+estremos) div 2;
  24.     pivot:=v[medio];
  25.     repeat
  26.       if (ordinato) then
  27.          begin
  28.             while (v[inf]<pivot) do  inf:=inf+1;
  29.             while (v[sup]>pivot) do  sup:=sup-1;
  30.          end;
  31.       if inf<=sup then
  32.        begin
  33.          scambia(v[inf],v[sup]);
  34.          scambia(u[inf],u[sup]);
  35.          scambia(w[inf],w[sup]);
  36.          scambia(z[inf],z[sup]);
  37.          inf:=inf+1;
  38.          sup:=sup-1;
  39.        end;
  40.     until inf>sup;
  41.     if (estremoi<sup) then ordinamento(estremoi,sup,v,u,w,z,ordinato);
  42.     if (inf<estremos) then ordinamento(inf,estremos,v,u,w,z,ordinato);
  43. end;
  44.  
  45. Procedure ricerca (var t:elenco;amicizia:Longint); 
  46.   var i,m,inizio,fine: longint;
  47.  
  48.  begin  
  49.    inizio:=1; fine:=N;
  50.    repeat
  51.       m:=(inizio + fine) div 2;
  52.       if t[m]<=amicizia then inizio:=m+1;
  53.       if t[m]>amicizia then fine:=m-1;
  54.     until inizio>fine;
  55.  
  56.     if (t[m]<=amicizia) then writeln(m)
  57.                      else writeln (m-1);
  58.  
  59.  end;
  60. begin
  61. {
  62.     uncomment the two following lines if you want to read/write from files
  63.     assign(input,  'input.txt');  reset(input);
  64.     assign(output, 'output.txt'); rewrite(output);
  65. }
  66.  
  67.     ReadLn(N);
  68.  
  69.     for i:=1 to N do
  70.         ReadLn(ID[i], A[i], B[i], C[i]);
  71.  
  72.     K := 0;
  73.  
  74.     ordinamento (1,N,ID,A,B,C, true);
  75.     for i:=1 to N do writeln(ID[i],' ',a[i],' ',B[i],' ',C[i]); 
  76.     amico:=3;
  77.     ricerca (ID,amico);
  78.  
  79.  
  80.     WriteLn(K);
  81.  
  82. end.
  83.  
Success #stdin #stdout 0s 5304KB
comments (?)
stdin
copy 
4
0 1 2 3
1 0 2 3
3 -1 2 1
2 1 -1 -1
stdout
copy 
0 1 2 3
1 0 2 3
2 1 -1 -1
3 -1 2 1
4
0
https://ideone.com/Mq9uiG
language:
Pascal (fpc 3.0.4)
created:
5 days 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!