I got wa !~

this is my prog
I want some test

var w:array [0..2097152] of longint;
    data,f:array [0..21] of longint;
    i,n:longint;
  function get(i,h,l:longint):byte;
    var s:integer;
  begin
    s:=0;
    while (h and f[i]=0) and (s<n) and (f[i] and l=0) do begin
      i:= i mod n+1;inc(s);
    end;
    if (s=n) or (f[i] and l>0) then get:=0 else get:=i;
  end;
  function search(hash,s:longint):longint;
    var min,now,k1,k2,k3,d,h,i,been:longint;
  begin
    if w[hash]>-1 then begin search:=w[hash];exit;end;
    if s<=3 then begin
      w[hash]:=0;
      search:=0;
    end
    else begin
      min:=maxint;been:=0;
      k1:=get(1,hash,0);
      been:=f[k1];
      k2:=get(k1 mod n+1,hash,been);
      been:=been or f[k2];
      k3:=get(k2 mod n+1,hash,been);
      been:=been or f[k3];
      while true do begin
        h:=((hash xor f[k1]) xor f[k2]) xor f[k3];
        d:=0;
        for i:=1 to n do if h and f[i]>0 then d:=d+data[i];
        now:=d+search(h,s-3);
        if now < min then min:=now;
        k1:=k2;k2:=k3;k3:=get(k3 mod n+1,hash,been);
        been:=been or k3;
        if k3=0 then break;
      end;
      w[hash]:=min;
      search:=min;
    end;
  end;
begin
  f[1]:=1;
  for i:=2 to 21 do f[i]:=f[i-1]*2;
  readln(n);
  for i:=1 to n do read(data[i]);
  readln;
  for i:=1 to f[n]*2 do w[i]:=-1;
  writeln(search(f[n+1]-1,n));
end.