Cod sursa(job #183750)

Utilizator TamasionutzIoan-Cornel Tamas Tamasionutz Data 22 aprilie 2008 15:45:11
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.48 kb
var v,s:array [1..1000000] of longint;
n,sum,l:longint;
f,t:text;
procedure citire;
var i:longint;
begin
readln(f,n,sum);
for i:=1 to n do read(f,v[i]);
end;

procedure suma3;
var i,j,k:longint;
begin
l:=0;
for i:=1 to n do
for j:=1 to n do
for k:=1 to n do
begin
l:=l+1;
s[l]:=v[i]+v[j]+v[k];
           end;
    end;
  
   { procedure heapsort;
    var s1,d:integer;
  27.     x:longint;
  28.    procedure deplasare(s1,d:integer);
  29.     var i,j:integer;
  30.       ret:boolean;
  31.     begin
  32.      i:=s1;
  33.      j:=2*i;
  34.      x:=s[i];
  35.      ret:=false;
  36.      while (j<=d) and (not ret) do
  37.        begin
  38.        if j<d then
  39.          if s[j]<s[j+1] then j:=j+1;
  40.        if x<s[j] then
  41.          begin
  42.          s[i]:=s[j]; 
  43.          i:=j; 
  44.          j:=2*i; 
  45.          end 
  46.        else ret:=true; 
  47.      end; 
  48.      s[i]:=x; 
  49.     end; 
  50.   begin 
  51.    s1:=(l div 2)+1; 
  52.    d:=l; 
  53.    while s1>1 do 
  54.      begin 
  55.      s1:=s1-1; 
  56.      deplasare(s1,l); 
  57.      end; 
  58.    while d>1 do 
  59.      begin 
  60.      x:=s[1]; 
  61.      s[1]:=s[d]; 
  62.      s[d]:=x; 
  63.      d:=d-1; 
  64.      deplasare(1,d); 
  65.      end; 
  66.   end;}  
  67.   
  68.  procedure qsort(s1,d:longint);  
  69.   var i,j,x,y:longint;  
  70.   begin  
  71.    i:=s1;  
  72.    j:=d;  
  73.    x:=s[(s1+d)div 2];  
  74.    repeat  
  75.    while s[i]<x do i:=i+1;  
  76.    while s[j]>x do j:=j-1;  
  77.    if i<=j then  
  78.      begin  
  79.      y:=s[i];  
  80.      s[i]:=s[j];  
  81.      s[j]:=y;  
  82.      i:=i+1;  
  83.      j:=j-1;  
  84.      end;  
  85.    until i>j;  
  86.    if s1<j then qsort(s1,j);  
  87.    if d>i then qsort(i,d);  
  88.   end;  
  89.   
  90.  procedure afisare(p:longint);  
  91.   var i,j,k,e:longint;  
  92.      ok:boolean;  
  93.   begin  
  94.    ok:=false;  
  95.    i:=0;  
  96.    while (i<>n) and (not ok) do  
  97.      begin  
  98.      i:=i+1;  
  99.      j:=0;  
 100.      while (j<>n) and (not ok) do  
 101.        begin  
 102.        j:=j+1;  
 103.        k:=0;  
 104.        while (k<>n) and (not ok) do  
 105.          begin  
 106.          k:=k+1;  
 107.          if v[i]+v[j]+v[k]=s[p] then  
 108.            begin  
 109.            write(t,v[i],' ',v[j],' ',v[k],' ');  
 110.            ok:=true;  
 111.            end;  
 112.          end;  
 113.        end;  
 114.      end;  
 115.   end;  
 116.   
 117.  procedure suma;  
 118.   var p,u:longint;  
 119.     ok:boolean;  
 120.   begin  
 121.    ok:=false;  
 122.    p:=1;  
 123.    u:=l;  
 124.    while p<=u do  
 125.      begin  
 126.      if s[p]+s[u]=sum then  
 127.        begin  
 128.        ok:=true;  
 129.        afisare(p);  
 130.        afisare(u);  
 131.        p:=u+1;  
 132.        end  
 133.      else begin  
 134.           while (s[p]+s[u]>sum) and (u>=1) do u:=u-1;  
 135.           while (s[p]+s[u]<sum) and (p<=l) do p:=p+1;  
 136.           end;  
 137.      end;  
 138.    if not ok then write(t,'-1');  
 139.   end;  
 140.   
 141. begin  
 142.   assign(f,'loto.in');  
 143.   assign(t,'loto.out');  
 144.   reset(f);  
 145.   rewrite(t);  
 146.   citire;  
 147.   suma3;  
 148.   qsort(1,l);  
 149.   suma;  
 150.   close(f);  
 151.   close(t);  
 152. end.