You have n problems. You have estimated the difficulty of the i-th one as integer ci. Now you want to prepare a problemset for a contest, using some of the problems you've made.A problemset for the contest must consist of at least two problems. You think that the total difficulty of the problems of the contest must be at least l and at most r. Also, you think that the difference between difficulties of the easiest and the hardest of the chosen problems must be at least x.Find the number of ways to choose a problemset for the contest.

The first line contains four integers n, l, r, x (1 ≤ n ≤ 15, 1 ≤ l ≤ r ≤ 109, 1 ≤ x ≤ 106) — the number of problems you have, the minimum and maximum value of total difficulty of the problemset and the minimum difference in difficulty between the hardest problem in the pack and the easiest one, respectively. The second line contains n integers c1, c2, ..., cn (1 ≤ ci ≤ 106) — the difficulty of each problem.

Print the number of ways to choose a suitable problemset for the contest.

NoteIn the first example two sets are suitable, one consisting of the second and third problem, another one consisting of all three problems.In the second example, two sets of problems are suitable — the set of problems with difficulties 10 and 30 as well as the set of problems with difficulties 20 and 30.In the third example any set consisting of one problem of difficulty 10 and one problem of difficulty 20 is suitable.

program Quick_Sort;
 var A:array[1..100000] of int64;
 N,i,L,R,x,e : longint;
 count,mask,k,t,hard,min,max:int64;

procedure QSort(L,R:longint);
 var i,j:longint;
     X,Y:int64;
begin
 X:=A[random(r+1-l)+l];
 i:=L; j:=R;
 while i<=j do
  begin
   while A[i]<X do i:=i+1;
   while A[j]>X do j:=j-1;
     if i<=j then
       begin
         y:=A[i]; A[i]:=A[j]; A[j]:=y;
         i:=i+1; j:=j-1;
       end;
  end;
  if L<j then QSort(L,j);
  if i<R then QSort(i,R);
end;

begin
 randomize;
 readln(N,L,R,X);
 for i:=1 to n do read(A[i]);
 QSort(1,n);

 count:=0;
 mask:=1;
 for i:=1 to N do mask:=mask*2;

 k:=2;
 while(k<=mask) do
 begin
  t:=k;
  min:=9999999999999999;
  max:=0;
  Hard:=0;
  e:=0;
  for i:=0 to N-1 do begin
   t:=k shr i;
   if(t and 1<>0) then begin Hard:=Hard+A[N-i];inc(e);end;
   if(t and 1<>0)and(max<A[N-i]) then max:=A[N-i];
   if(t and 1<>0)and(min>A[N-i]) then min:=A[N-i];
  end;

  if(Hard>=l)and(Hard<=r)and(max-min>=x)and(e>1) then inc(count);
  inc(k);
 end;
 write(count);
end.

var n,l,r,x,m,i:longint;
a:array[0..101] of longint;
function max(x,y:longint):longint;
begin
if x>y then exit(x);exit(y);
end;
function min(x,y:longint):longint;
begin
if x<y then exit(x);exit(y);
end;
procedure sc(t,h,x1,y1,rs:longint);
begin
if h>r then exit;
if t>n then
  begin
  if(h>=l)and(x1-y1>=x)and(rs>1)then m:=m+1;exit;
  end;
sc(t+1,h,x1,y1,rs);
sc(t+1,h+a[t],max(x1,a[t]),min(y1,a[t]),rs+1);
end;
begin
//assign(input,'zbalpkydh.in');reset(input);
//assign(output,'zbalpkydh.out');rewrite(output);
readln(n,l,r,x);
for i:=1 to n do read(a[i]);
sc(1,0,-maxlongint,maxlongint,0);
writeln(m);
close(input);close(output);
end.

var
  a, b, c, d, e, k, j, i, l, r, u, sum, p, o: int64;
  ar: array [1..1000] of int64;

function min(a, b: int64): int64;
begin
  if a < b then min := a
    else min := b;
end;

function max(a, b: int64): int64;
begin
  if a > b then max := a
    else max := b;
end;

begin
  readln(a, b, c, d);
  i := 1;
  while i <= a do begin
    read(ar[i]);
    inc(i);
  end;
  i := 1;
  e := 1;
  k := 0;
  while i <= a do begin
    inc(k, e);
    e := e * 2;
    inc(i);
  end;
  i := 3;
  o := 0;
  while i <= k do begin
    j := 1;
    p := a;
    l := 10000000;
    r := 0;
    u := 0;
    sum := 0;
    while j <= 16384 do begin
      if (i or j = i) then begin
        l := min(ar[p], l);
        r := max(ar[p], r);
        inc(sum, ar[p]);
        inc(u);
      end;
      dec(p);
      j := j * 2;
    end;
    if (r - l >= d) and (sum >= b) and (sum <= c) and (u >= 2) then inc(o);
    inc(i);
  end;
  writeln(o);
end.

uses math;
var i,n,l,r,y,x,j,k:longint;     a:array[1..15]of longint;
function vari(nom,mi,ma,s,kil:longint):longint;
begin
if nom>n then
begin
if (kil>1) and (ma-mi>=x) and (l<=s) and (r>=s) then
begin
inc(k);
end;
exit;
end;
vari(nom+1,min(mi,a[nom]),max(ma,a[nom]),s+a[nom],kil+1);
vari(nom+1,mi,ma,s,kil);
end;
begin
readln(n,l,r,x);
for i:=1 to n do
read(a[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
end;
vari(1,10000000,0,0,0);
writeln(k);
end.

var n,l,r,x,mask,k,sum,max,min,kol,i:longint; c:array[1..16] of longint;
begin
    read(n,l,r,x);
    for i:=1 to n do
    read(c[i]);
    k:=0;
    for mask:=1 to (1 shl n)-1 do
    begin
        sum:=0;
        max:=0;
        min:=1000000000;
        kol:=0;
        for i:=1 to n do
        if mask and (1 shl (i-1))> 0 then begin sum:=sum+c[i]; if c[i]> max then max:=c[i]; if c[i]<min then min:=c[i]; kol:=kol+1;  end;
        if (sum>=l) and (sum<=r) and (max-min>=x) and (kol>=2) then k:=k+1;
    end;
    writeln(k);
end.

Uses
  Math;
Const
  many=10000000;
Var
  n,l,r,x,ans,i:longint;
  m:array[1..15]of longint;
Procedure Ra(sum,mn,mx,kol,ps:longint);
Begin
  if ps=n+1 then
    begin
      if (kol>1)and(sum>=l)and(sum<=r)and(mx-mn>=x)then
        inc(ans)
    end
  else
    begin
      Ra(sum,mn,mx,kol,ps+1);
      Ra(sum+m[ps],min(mn,m[ps]),max(mx,m[ps]),kol+1,ps+1);
    end;
end;
begin
//  assign(input,'input.txt');assign(output,'output.txt');
  readln(n,l,r,x);ans:=0;
  for i:=1 to n do
    read(m[i]);
  Ra(0,many,-many,0,1);
  writeln(ans);
end.

uses math;
var
 a,b:array[1..1000] of longint;
 n,l,r,x,kol,ma,mi,res,ans,i,j:longint;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 b[n]:=1;
 kol:=1;
 for i:=1 to 1 shl n-1 do
 begin
  for j:=n downto 1 do
  begin
   if b[j]=0 then begin b[j]:=1;inc(kol);break;end;
   if b[j]=1 then begin b[j]:=0;dec(kol);end;
  end;
  if kol>=2 then
  begin
   ma:=0;
   mi:=maxlongint;
   res:=0;
   for j:=1 to n do if b[j]=1 then
   begin
    ma:=max(ma,a[j]);
    mi:=min(mi,a[j]);
    inc(res,a[j]);
   end;
   if (res>=l)and(res<=r)and(ma-mi>=x) then inc(ans);
  end;
 end;
 writeln(ans);
end.

uses math;

var n, l, r, x, kq, t, dem, sum, cmax, cmin, i: longint;
    c: array[0..20] of longint;

begin
    read (n, l, r, x);
    for i := 1 to n do read (c[i]);
    kq := 0;
    for t := 1 to ((1 SHL n) - 1) do
    begin
        dem := 0; sum := 0; cmax := 0; cmin := maxlongint;
        for i := 1 to n do
            if ((t shr (i - 1)) and 1) = 1 then
            begin
                inc (dem);
                sum := sum + c[i];
                cmax := max (cmax, c[i]);
                cmin := min (cmin, c[i]);
            end;
        if (dem >= 2) and (sum >= l) and (sum <= r) and (cmax - cmin >= x) then inc (kq);
    end;
    write (kq);
end.

var n,l,r,x,so:int64;i:longint; a:array[1..15] of int64; m:array[1..1000] of longint;
procedure kt(Vt:longint);
var i,max,min,t:longint;
begin
	min:=99999999;
	max:=0;
	t:=0;
	for i:=1 to vt do
	begin
		{writeln(m[i]);}
		if a[m[i]]>max then max:=a[m[i]];
		if a[m[i]]<min then min:=a[m[i]];
		t:=t+a[m[i]];
	end;
	if (t>=l) and (t<=r) and (max-min>=x) then inc(so);
	{writeln(t,' ',max,' ',min);}
end;
procedure de_quy(e,vt:int64);
var i,min1,max1:longint;
begin
	for i:=e to n do
	begin
		m[vt]:=i;
		if vt>1 then kt(vt);
		de_quy(i+1,vt+1);
	end;
end;
begin
	readln(n,l,r,x);
	for i:=1 to n do read(a[i]);
	de_quy(1,1);
	writeln(so);
end.

var
  hard:array[1..15]of longint;
  n,summax,summin,cha,i,j:longint;

procedure swap(num:longint;var min,max:longint);
begin
  if num>max then max:=num;
  if num<min then min:=num;
end;

function dfs(now,sum,min,max,choosed:longint):integer;
var ans:integer;
begin
  ans:=0;
  if now=n then
  begin

    if choosed>=2 then if (sum>=summin)and(sum<=summax)and(max-min>=cha) then ans:=ans+1;
    if choosed>=1 then
    begin
      swap(hard[n],min,max);
      sum:=sum+hard[n];
      if (sum>=summin)and(sum<=summax)and(max-min>=cha) then ans:=ans+1;
    end;
  end
  else
  begin
    ans:=ans+dfs(now+1,sum,min,max,choosed);

    swap(hard[now],min,max);
    sum:=sum+hard[now];
  ans:=ans+dfs(now+1,sum,min,max,choosed+1);
  end;
  dfs:=ans;
end;

begin
  readln(n,summin,summax,cha);
  for i:=1 to n do read(hard[i]);

  writeln(dfs(1,0,10000000,0,0));
end.

uses math;
var a:array[0..15] of longint;
    i,n,l,r,x,count,tmp:longint;
procedure sort(r,n:longint);
var key,c:longint;
begin
    key:=a[r];
    while (2*r<=n) do
        begin
            c:=2*r;
            if (c<n) and (a[c]<a[c+1]) then inc(c);
            if (key>=a[c]) then break;
            a[r]:=a[c];
            r:=c;
        end;
    a[r]:=key;
end;
procedure back(m,vmin,vmax,s,k:longint);
begin
    if (m>n) then
        begin
            if (k>1) and (vmax-vmin>=x) and (s>=l) and (s<=r) then
                inc(count);
            exit;
        end;
    back(m+1,min(vmin,a[m]),max(vmax,a[m]),s+a[m],k+1);
    back(m+1,vmin,vmax,s,k);
end;
begin
    readln(n,l,r,x);
    for i:=1 to n do read(a[i]);
    for i:=n div 2 downto 1 do sort(i,n);
    for i:=n downto 2 do
        begin
            tmp:=a[i];
            a[i]:=a[1];
            a[1]:=tmp;
            sort(1,i-1);
        end;
    count:=0;
    back(1,10000000,0,0,0);
    writeln(count);
end.

var
 otv,i,n,l,r,x,kol,min,sum,max:longint;
 a:array[1..100000]of longint;
procedure check(mask:longint);
var i:longint;
begin
 max:=-(maxlongint shr 1);
 min:=maxlongint shr 1;
 sum:=0;
 kol:=0;
 for i:=1 to n do
 if (1 shl (i-1))and mask>0 then
 begin
  inc(sum,a[i]);
  inc(kol);
  if max<a[i]then max:=a[i];
  if min>a[i]then min:=a[i];
 end;
 if (max-min>=x)and(sum>=l)and(sum<=r)and(kol>=2)then inc(otv);
end;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 for i:=0 to (1 shl n)-1 do
  check(i);
 writeln(otv);
end.

const
  fi='';
var
  dem,n,l,r,x,i,j,s,min,max:longint;
  a:Array[0..16] of longint;
  f:text;
begin
  assign(f,fi); reset(f);
  readln(f,n,l,r,x);
  if n=1 then
    begin
      writeln(0); exit;
    end;
  for i:=1 to n do read(f,a[i]);
  for i:=1 to (1 shl n)-1 do
    begin
      s:=0;
      min:=100000000;
      max:=-1;
      for j:=1 to n do
        if (i shr (j-1)) and 1 = 1 then
          begin
            s:=s+a[j];
            if a[j]>max then max:=a[j];
            if a[j]<min then min:=a[j];
          end;
      if (s>=l) and (s<=r) and (max-min>=x) then inc(dem);
    end;
  writeln(dem);
  readln;
end.

{**
 *  Author  : Nguyen Canh Toan
 *  Problem : Preparing Olympiad
 *  Link    : https://codeforces.com/problemset/problem/550/B
**}
uses math;
const std='550B';
      lim=100001;
      ii=low(int64);
      oo=high(int64);
var n,l,r,x,ans:int64;
    c,masks:array [0..lim] of int64;
    input,output:text;
procedure cal();
var i:longint;
    sum,cmax,cmin:int64;
begin
  sum:=0;
  for i:=1 to n do
   if (masks[i]=1) then sum:=sum+c[i];
  if (sum<l) or (sum>r) then exit;
  cmax:=ii;cmin:=oo;
  for i:=1 to n do
   if (masks[i]=1) then
      begin
        cmax:=max(cmax,c[i]);
        cmin:=min(cmin,c[i]);
      end;
  if (cmax<>ii) and (cmin<>oo) and (cmax-cmin>=x) then inc(ans);
end;
procedure backtrack(i:longint);
begin
  if (i>n) then
     begin
       cal();
       exit;
     end;
  masks[i]:=0;
  backtrack(i+1);
  masks[i]:=1;
  backtrack(i+1);
end;
procedure main();
var i:longint;
begin
  readln(n,l,r,x);
  for i:=1 to n do read(c[i]);
  ans:=0;
  backtrack(1);
  write(ans);
end;
BEGIN
  //assign(input,std+'.inp');reset(input);
  //assign(output,std+'.out');rewrite(output);
    main();
  //close(input);
  //close(output);
END.

uses
    math;

var
    a:array[0..100] of int64;
    i,j,bit,ans:longint;
    n,l,r,x,sum,mx,mn:int64;

Begin
    read(n,l,r,x);
    for i:=1 to n do
        read(a[i]);
    ans:=0;
    for i:=1 to 1 shl n - 1 do
        begin
            bit:=0; sum:=0;
            mn:=trunc(1e16); mx:=-trunc(1e6);
            for j:=0 to n-1 do
                if (i and (1 shl j) > 0) then
                    begin
                        inc(bit);
                        inc(sum,a[j+1]);
                        mx:=max(mx,a[j+1]);
                        mn:=min(mn,a[j+1]);
                    end;
            if (bit > 1) and (sum >= l) and (sum <= r) and (mx - mn >= x)then
                inc(ans);
        end;
    writeln(ans);
end.

{$APPTYPE CONSOLE}
{$R+,Q+}

uses
  SysUtils;

var
  n,l,r,x,ans:integer;
  s,c:array[1..15] of integer;

procedure Search(i:integer);
var
  j,min,max,cnt,sum:integer;
begin
  if i>n then begin
    cnt:=0;
    for j:=1 to n do
        if s[j]=1 then cnt:=cnt+1;
    if cnt>=2 then begin
      sum:=0;
      max:=-1000000;
      min:=1000000;
      for j:=1 to n do
        if s[j]=1 then begin
            sum:=sum+c[j];
            if max<c[j] then max:=c[j];
            if min>c[j] then min:=c[j];
        end;
      if (sum>=l) and (sum<=r) and (max-min>=x) then inc(ans);
    end;
    exit;
  end;
  Search(i+1);
  s[i]:=1;
  Search(i+1);
  s[i]:=0;
end;

var
  i,j:integer;

begin

  Readln(n,l,r,x);
  for i:=1 to n do Read(c[i]);
  for i:=1 to n do begin
    s[i]:=0;
  end;
  ans:=0;
  Search(1);
  writeln(ans);
end.

VAR
        n,s,min,i,l,r,kq,x,j,tam : longint;
        a : array[0..16] of longint;
        d : array[0..16] of longint;

Function kt : boolean;
var     i,dd,cc,s,dem : longint;
        begin
                s := 0; dem := 0;
                for i := 1 to n do
                if d[i] = 1 then begin
                        s := s + a[i];
                        inc(dem);
                end;
                if dem = 1 then exit(false);
                for dd := 1 to n do
                        if d[dd] = 1 then break;
                for cc := n downto 1 do
                        if d[cc] = 1 then break;
                if (s>= l) and (s<= r) and (a[cc]-a[dd] >=x ) then exit(true)
                else exit(false);
        end;

Procedure THU(k : longint);
var     i : longint;
        begin
                if k = n + 1 then begin
                        if kt then inc(kq);
                        exit;
                end;
                for i := 0 to 1 do begin
                        d[k] := i;
                        THU(k+1);
                        d[k] := 0;
                end;
        end;

BEGIN
        read(n,l,r,x);
        for i := 1 to n do read(a[i]);
        for i := 1 to n-1 do
                for j := i+1 to n do
                        if a[i] > a[j] then begin
                                tam := a[i];
                                a[i] := a[j];
                                a[j] := tam;
                        end;
        THU(1);
        write(kq);
END.

var cnt,st,n,l,r,x,ans,i,j,sum,tmin,tmax,o:longint;
a:array[0..100]of longint;
function max(x,y:longint):longint;
begin if x>y then exit(x);exit(Y);end;
function min(x,y:longint):longint;
begin if x<y then exit(x);exit(y);end;
begin
//assign(input,'zbalpkydh.in');reset(input);
//assign(output,'zbalpkydh.out');rewrite(output);
readln(n,l,r,x);
for i:=1 to n do read(a[i]);
st:=1<<n;
for i:=1 to st-1 do
  begin
  j:=i;o:=0;
  cnt:=0;sum:=0;tmin:=maxlongint;tmax:=-maxlongint;
  while j>0 do
    begin
    inc(o);
    if j mod 2=1 then
      begin
      inc(cnt);
      tmax:=max(tmax,a[o]);
      tmin:=min(tmin,a[o]);
      sum:=sum+a[o];
      end;
    j:=j div 2;
    end;
  if(cnt>=2)and(sum>=l)and(sum<=r)and(tmax-tmin>=x)then inc(ans);
  end;
writeln(ans);
close(input);close(output);
end.

var i,j,n,k,r,l,m,l1,m1,l2,j1,z,x,min,max,sum,kol,koli:longint;
a,b:array [0..1000000] of longint;
s:string;
begin
max:=-1;
min:=9999999999;
  k:=2;
kol:=0;
read(r,z,l,x);
n:=r;
for i:=1 to r do
read(b[i]);
for i:=0 to n do a[i]:=0; 	{����塞���ᨢ }
while a[0]=0 do		{���� �� ��諨 �� �㫥��� ����� - �믮��塞 ��ॡ�� }
begin
sum:=0;
max:=-1;
min:=9999999999;
koli:=0;
for l1:=1 to n do
begin
if (a[l1]*b[l1]>max) and(a[l1]*b[l1]>0)    then
max:=a[l1]*b[l1];
if (a[l1]*b[l1]<min) and (a[l1]*b[l1]>0) then
min:=a[l1]*b[l1];

if a[l1]*b[l1]<>0 then
sum:=a[l1]*b[l1]+sum;
koli:=koli+1;
end;
if (sum>=z) and (sum<=l) and(max-min>=x)and (koli>=2)  then
begin
kol:=kol+1;

end;
i:=n;

  {���� � ���� ���ᨢ� }
while a[i]=k-1 do	{���� ����� ࠢ�� ��᫥���� ��� k-�筮� ��⥬� }
begin
a[i]:=0; 	{����塞  ����� ���ᨢ� }
dec(i);		{㬥��蠥�i }
end;
inc(a[i]);

end;
write(kol);

end.

program nabory;
var a:array[1..100] of longint;
    n,l,r,x,c,t,i,q,kol,j,np,k1,k2,pr,f,ans:longint;  g:int64;
    s:string;
begin
read(n,l,r,x);
for i:=1 to n do
read(a[i]);

for i:=1 to n-1 do
for j:=1 to n-i do
if a[j]>a[j+1] then begin
                    np:=a[j];
                    a[j]:=a[j+1];
                    a[j+1]:=np;
                    end;
ans:=0;
s:='';
t:=1;
for i:=1 to n do
t:=t*2;
dec(t);
g:=0;
for i:=1 to t do
begin
t:=i;
while(t<>0) do
begin
if t mod 2=0 then s:=s+'0';
if t mod 2<>0 then s:=s+'1';
t:=t div 2;

end;

for j:=1 to length(s) do
begin
        for f:=1 to length(s) do
        if s[f]='1' then begin k1:=a[f]; break; end;
        for f:=length(s) downto 1 do
        if s[f]='1' then begin k2:=a[f]; break; end;

val(s[j],c,q);
if c=1 then begin g:=g+a[j]; inc(kol); end;
end;

        pr:=abs(k1-k2);

if (g>=l) and (g<=r) and (kol>=2) and (pr>=x) then  inc(ans);

g:=0;
kol:=0;
s:='';
end;

writeln(ans);

end.

program z1;
type niz=array[1..15] of longint;
var n,i,j,z,h,y:integer;
x,l,r,br,t,s:longint;
a,b:niz;
function brojanje (n:integer;var a:niz):integer;
        var i,j:integer;
        begin
        i:=n;
        while (i>0) and (a[i]=1) do
                i:=i-1;
        if (i=0) then brojanje:=0
        else
                begin
                brojanje:=1;
                a[i]:=1;
                for j:=i+1 to n do
                        a[j]:=0;
                end;
        end;
begin
readln(n,l,r,x);
for i:=1 to n do
        read (a[i]);
for i:=1 to n-1 do
        for j:=i+1 to n do
                if (a[i]>a[j]) then
                        begin
                        t:=a[i];
                        a[i]:=a[j];
                        a[j]:=t;
                        end;
for i:=1 to n do
        b[i]:=0;
br:=0;
repeat
z:=0;
s:=0;
for i:=1 to n do
        if (b[i]=1) then z:=z+1;
if (z>1) then
begin
z:=0;
for i:=n downto 1 do
        begin
        if (b[i]=1) then
                begin
                h:=i;
                s:=s+a[i];
                end;
        if (z=0) and (b[i]=1) then
                begin
                y:=i;
                z:=1;
                h:=i;
                end;
        end;
if (s>=l) and (s<=r) and (a[y]-a[h]>=x) then
        br:=br+1;
end;
until (brojanje (n,b)=0);
writeln (br);
end.

uses math;
const   fi='';
        fo='';
var     n,l,r,x,gt:longint;
        a:array[1..100] of longint;
procedure doc;
var     f:Text;
        i:longint;
begin
        assign(f,fi);
        reset(f);
        gt:=1;
        readln(f,n,l,r,x);
        for i:=1 to n do
        begin
                read(f,a[i]);
                gt:=gt*2;
        end;
        close(f);
end;
procedure sort(l,r:longint);
var     i,j,x,y:longint;
begin
        x:=a[(r+l) div 2];
        i:=l;
        j:=r;
        while i<j do
        begin
                while a[i]<x do
                        inc(i);
                while a[j]>x do
                        dec(j);
                if i<=j then
                begin
                        y:=a[i];
                        a[i]:=a[j];
                        a[j]:=y;
                        inc(i);
                        dec(j);
                end;
        end;
        if i<r then sort(i,r);
        if l<j then sort(l,j);
end;
function kt(k:longint):boolean;
var     i,j,t,sl,ln,nn:longint;
begin
        t:=0; j:=0; sl:=0; nn:=0;
        while k>0 do
        begin
                inc(j);
                i:=k mod 2;
                k:=k div 2;
                if i=1 then
                begin
                        t:=t+a[j];
                        inc(sl);
                        if nn=0 then nn:=a[j];
                        ln:=a[j];
                end;
        end;
        if (sl>1) and (t>=l) and (t<=r) and (ln-nn>=x) then
                exit(true)
        else
                exit(false);
end;
procedure xl;
var     f:Text;
        dem,i:longint;
begin
        assign(f,fo);
        rewrite(f);
        dem:=0;
        sort(1,n);
        for i:=1 to gt-1 do
        begin
                if kt(i)=true  then
                        inc(dem);
        end;
        write(f,dem);
        close(f);
end;
begin
        doc;
        xl;
end.

var
 f : array [0..111111] of longint;
 min,max,l,r,n,res,i,j,k,m,h,c,x,z : longint;

begin
 readln(n, l, r, x);
 for i:=1 to n do read(f[i]);
 res:=0;
 z:=1 shl n;

 for i:=0 to z do
 begin
  min:=maxlongint;
  max:=0;
  h:=0;
  for j:=1 to n do if (i shr (n - j)) and 1 = 1 then
  begin
   if f[j] > max then max:=f[j];
   if f[j] < min then min:=f[j];
   inc(h, f[j]);
  end;
  if (max - min >= x)and(h >= l)and(h <= r) then inc(res);
 end;
 writeln(res);
end.

var
        n , l , r , xx , kq : longint;
        a , x : array[0..16] of longint;
procedure tv( i : longint );
var
        j , dau , cuoi , tong : longint;
begin
        if i = n + 1 then
        begin
                tong := 0;
                for j := 1 to n do
                        if x[ j ] = 1 then
                                tong := tong + a[ j ];
                for j := 1 to n do
                        if x[ j ] = 1 then
                        begin
                                dau := j;
                                break;
                        end;
                for j := n downto 1 do
                        if x[ j ] = 1 then
                        begin
                                cuoi := j;
                                break;
                        end;
                if ( tong >= l ) and ( tong <= r ) and ( a[ cuoi ] - a[ dau ] >= xx ) then
                        inc( kq );
                exit;
        end;
        for j := 0 to 1 do
        begin
                x[ i ] := j;
                tv( i + 1 );
        end;
end;
procedure xuli;
var
        i , j , k , tam : longint;
begin
        read( n , l , r , xx );
        for i := 1 to n do
                read( a[ i ] );
        for i := 1 to n do
                for j := i + 1 to n do
                        if a[ i ] > a[ j ] then
                        begin
                                tam := a[ i ];
                                a[ i ] := a[ j ];
                                a[ j ] := tam;
                        end;
        kq := 0;
        tv( 1 );
        write( kq );
end;
begin
        xuli;
end.

var
 z,q,ans,l,r,i,j,n,m,k,t,x:longint;
 a,b:array[0..111]of longint;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 for i:=0 to 1 shl n-1 do
 begin
  k:=0;q:=0;
  for j:=0 to 15 do if i shr j and 1=1 then begin inc(k);b[k]:=a[n-j];inc(q,b[k]);end;
  for j:=1 to k-1 do for z:=j+1 to k do if b[j]>b[z] then
  begin t:=b[j];b[j]:=b[z];b[z]:=t;end;
  if(q>=l)and(q<=r)and(b[k]-b[1]>=x)then inc(ans);
 end;
 writeln(ans);
end.

//uses sysutils;

const
  inf = trunc(1E9);

var
  n,l,r,x,i,ans: longint;
  a: array [1..20] of longint;
  v: array [1..20] of boolean;

procedure complete(t: longint);
var i,maxn,minn,sum: longint;
begin
  if t > n then begin
    sum := 0;
    for i := 1 to n do if v[i] then inc(sum,a[i]);
    minn := inf;
    maxn := 0;
    for i := 1 to n do if v[i] and (a[i] > maxn) then maxn := a[i];
    for i := 1 to n do if v[i] and (a[i] < minn) then minn := a[i];

    if (maxn - minn >= x) and (sum >= l) and (sum <= r) then inc(ans);
    exit;
  end;

  v[t] := true;
  complete(t+1);
  v[t] := false;
  complete(t+1);
end;

begin
  read(n,l,r,x);
  for i := 1 to n do read(a[i]);

  ans := 0;
  complete(1);

  write(ans);
end.

const   fi='';
        fo='';
var     f,g:text;
        a,bang:Array[1..15] of longint;
        i,j,n,l,r,x,kq,t:longint;
        procedure xuli;
        var     min,max,sum,i:longint;
                begin
                        min:=n;
                        max:=1;
                        sum:=0;
                        for i:=1 to n do
                                if bang[i]=1 then
                                begin
                                        if min>i then min:=i;
                                        if max<i then max:=i;
                                        inc(sum,a[i]);
                                end;
                        if a[max]-a[min]>=x then
                                if (sum>=l) and (sum<=r) then inc(kq);
                end;
        procedure tao(vt:byte);
        var     i:byte;
                begin
                        if vt>n then xuli else
                        for i:=1 downto 0 do
                        begin
                                bang[vt]:=i;
                                tao(vt+1);
                        end;
                end;
begin
        assign(f,fi);
        reset(F);
        assign(g,fo);
        rewrite(g);
        readln(f,n,l,r,x);
        for i:=1 to n do
                read(f,a[i]);
        close(f);

        kq:=0;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                        if a[i]>A[j] then
                        begin
                                t:=a[i];
                                a[i]:=a[j];
                                a[j]:=t;
                        end;
        fillchar(bang,sizeof(bang),0);
        tao(1);
        writeln(g,kq);
        close(g);
end.

uses math;
type arr=array [0..15] of longint;
var x,a:arr;
    kq,tong,smin,smax,n,l,r,k,i:longint;
procedure update(var x:arr);
begin
    tong:=0;
    smin:=maxlongint;
    smax:=-maxlongint;
    for i:=1 to n do
    if x[i]=1 then
    begin
        inc(tong,a[i]);
        smin:=min(smin,a[i]);
        smax:=max(smax,a[i]);
    end;
    if (tong>=l) and (tong<=r) and (smax-smin>=k) then inc(kq);
end;
procedure trya(i,k:longint);
var j:longint;
begin
    for j:=0 to 1 do
    begin
        x[i]:=j;
        if i=k then update(x)
        else trya(i+1,k);
    end;
end;
begin
    read(n,l,r,k);
    for i:=1 to n do
        read(a[i]);
    trya(1,n);
    write(kq);
end.

var a:array[1..15] of longint;
    s:array[0..32768] of integer;
    n,l,r,x,i,j,max,min,dem:longint;
Function GetBIT(k , x : LongInt) : LongInt;
        begin
          GetBIT := (x shr (k-1)) and 1;
        end;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 dem:=0;
 for i:=0 to (2 shl (n-1)) -1 do
  begin
   min:=1000000000;
   max:=-1000000000;

   for j:=1 to n do
     begin
        s[i]:=s[i]+a[j]*getbit(j,i);
        if getbit(j,i)<>0
        then
         begin
          if a[j]<min then min:=a[j];
          if a[j]>max then max:=a[j];
         end;

     end;
   if (s[i]>=l) and (s[i]<=r) and (max-min>=x) then inc(dem);
  end;
 writeln(dem);
 readln;
 readln;
end.

var n,l,r,x,i,j,min,max,d:longint;
t:int64;
a:array[1..15] of longint;
procedure xl(i:longint);
var h,k:longint;
   begin
        if i=n+1 then
           begin
                if (l<=t) and (t<=r) and (max-min>=x) then inc(d);
           end
        else
           begin
                h:=min;k:=max;
                xl(i+1);
                t:=t+a[i];
                if a[i]>max then max:=a[i];
                if a[i]<min then min:=a[i];
                xl(i+1);
                t:=t-a[i];
                min:=h;max:=k;
           end;
   end;
   begin
        min:=high(min);max:=low(max);
        read(n,l,r,x);
        for i:=1 to n do read(a[i]);
        xl(1);
        writeln(d);
   end.

uses math;
var c: array[0..20] of longint;
    n,l,x,r,i,kq,t,dem,s,cmax,cmin:longint;
begin
    //assign(input,'Olympiad.inp');
    //reset(input);
    readln(n,l,r,x);
    for i:=1 to n do read(c[i]);
    kq:=0;
    For t:=1 to ((1 SHL n)-1) do
    begin
        dem:=0;
        s:=0;
        cmax:=0;
        cmin:=maxlongint;
        for i:= 1 to n do
            if ((t shr (i-1)) and 1) = 1 then
            begin
                inc(dem);
                s:=s+c[i];
                cmax:=max(cmax,c[i]);
                cmin:=min(cmin,c[i]);
            end;
        if (dem>=2) and (s>=l) and (s<=r) and (cmax-cmin>=x) then inc(kq);
    end;
    Writeln(kq);
end.

var ans,n,l,r,x,sum,max,min,pp:int64;
i,j:longint;
a:array[0..100001] of int64;
begin
//assign(input,'zbalpkydh.in');reset(input);
//assign(output,'zbalpkydh.out');rewrite(output);
readln(n,l,r,x);
for i:=1 to n do read(a[i]);
for i:=0 to 1 shl n-1 do
     begin
     sum:=0;max:=0;min:=maxlongint;pp:=0;
     for j:=1 to n do
        if i shr (j-1) mod 2=1 then
             begin
             sum:=sum+1;
             pp:=pp+a[j];
             if a[j]>max then max:=a[j];
             if a[j]<min then min:=a[j];
             end;
     if(sum>=2)and(pp>=l)and(pp<=r)and(max-min>=x)then ans:=ans+1;
     end;
writeln(ans);
close(input);close(output);
end.

uses
    math;

var
    a:array[0..100] of int64;
    i,j,bit,ans:longint;
    n,l,r,x,sum,mx,mn:int64;

Begin
    read(n,l,r,x);
    for i:=1 to n do
        read(a[i]);
    ans:=0;
    for i:=1 to 1 shl n - 1 do
        begin
            bit:=0; sum:=0;
            mn:=trunc(1e16); mx:=-trunc(1e6);
            for j:=0 to n-1 do
                if (i and (1 shl j) > 0) then
                    begin
                        inc(bit);
                        inc(sum,a[j+1]);
                        mx:=max(mx,a[j+1]);
                        mn:=min(mn,a[j+1]);
                    end;
            if (bit > 1) and (sum >= l) and (sum <= r) and (mx - mn >= x)then
                inc(ans);
        end;
    writeln(ans);
end.

var
  a:array [0..16] of longint;
  n,i,j,sum,dem,s,mint,maxt,l,r,x:longint;
function getbit(x,y:longint):longint;
  begin
    getbit:=(x shr y) and 1;
  end;
begin
  readln(n,l,r,x);
  if n=1 then begin writeln(0); halt; end;
  for i:=1 to n do read(a[i]);
  dem:=0;
  for i:=1 to (2 shl (n-1))-1 do
    begin
      mint:=maxlongint;
      maxt:=-maxlongint;
      sum:=0; s:=0;
      for j:=1 to n do
        if getbit(i,j-1)=1 then
          begin
            sum:=sum+a[j];
            if maxt<a[j] then maxt:=a[j];
            if mint>a[j] then mint:=a[j];
            inc(s);
          end;
        if (s>1) and (l<=sum) and (sum<=r) and (maxt-mint>=x) then inc(dem);
    end;
  writeln(dem);
end.

var n,l,r,x,mask,k,sum,max,min,kol,i:longint; c:array[1..16] of longint;
begin
    read(n,l,r,x);
    for i:=1 to n do
    read(c[i]);
    k:=0;
    for mask:=1 to (1 shl n)-1 do
    begin
        sum:=0;
        max:=0;
        min:=1000000000;
        kol:=0;
        for i:=1 to n do
        if mask and (1 shl (i-1))> 0 then begin sum:=sum+c[i]; if c[i]> max then max:=c[i]; if c[i]<min then min:=c[i]; kol:=kol+1;  end;
        if (sum>=l) and (sum<=r) and (max-min>=x) and (kol>=2) then k:=k+1;
    end;
    writeln(k);
end.

     const eps=0.0000000001;  besk=20000000000008;  nn=2000000;

   label 1,2,3,4;
    type   { real=double;}  {string=ansistring;}
    int64=longint;
    mas=array [-10000..nn] of int64;   point=record x,y,z:real;end;
    zap=record p1,p2,p3 :int64;end; zap1=^zap;
    mass=array[0..nn] of int64;mass1=^mass;
    var r,pp,p1,p2,x1,y1,x2,y2,h1,h2,k,n,p,t1,t2,mmas,vol,ll,ot,maxzah, period1,ppp,modul,kol,t,sum,k1,q,pos,z,imax,p3,p4,l,nm,s1,s2,m,s,period2,dl:int64;
    mask,step, i,j:longint;
   x,kk,osn, aa,bb, cc,dd:int64;
   a1,b1, per, d1,mm,tt,y,fact,d,c,aold,b,a:array[-100000..500000] of int64;
     dp,dpnew:  array[-10..1200,-10..1200] of int64;
    dda:   array[-100..120000] of extended;
     marked:array[-10..3000030] of boolean;
   zanx,zany:array[-10..600000] of boolean;
   zan2:array[-10..200,-10..200] of boolean;
    sss, ss1,ss2:string;
    sot:array [-10..1000000] of char;
     prost,zan,fl:array[-10..6000000] of boolean;
    ssss:string;ch:char;
    mnog:array[0..5000000,1..8] of longint;
   ddp, pole :array [-100..2000000] of extended;
    slov,ss,maxpr:array[-10..100000] of string;
    st2:array[0..nn] of string;
     ott,v0,s0,t0:extended;
     zv:point;
     newx,newy,xx,yy:array[-1..200000] of int64;

     yot:double;
       flag,flag1:boolean;
    function phi(x,y:real):real; var t0,t1,p,s0,s1:real;
 begin
     if (x>0)and(y>=0) then p:=arctan(y/x);
     if x<0 then p:=pi+arctan(y/x);
     if(x>0)and(y<0) then p:=2*pi+arctan(y/x);
     if x=0 then if (y>=0) then p:=pi/2 else p:=3*pi/2;
     phi:=p/pi*180;
 end;
  function min(x,y:extended):extended;begin min:=x;if y<x then min:=y; end;
  function max(x,y:extended):extended;begin max:=x;if y>x then max:=y; end;

  function nod(x,y:int64):int64; var z:int64;
begin   repeat  z:=x mod y;x:=y;y:=z;   until  z=0 ;  nod:=x;end;

function degg(p,deg:int64):int64; var pp,q:int64;
 begin if deg=0 then degg:=1 else begin   if odd(deg) then degg:=degg(p,deg-1)*p mod modul else
 begin q:=(degg(p,deg shr 1)) mod modul; degg:=(q*q) mod modul;   end; end;   end;

begin
   { assign (input,'input.txt');reset(input);
      assign (output,'output.txt'); rewrite(output);
    }
  read(n,l,r,x); for i:=1 to n do read(a[i]);
  for i:=1 to n do for j:=1 to n-1 do if a[j]>a[j+1] then
   begin  p:=a[j]; a[j]:=a[j+1]; a[j+1]:=p;  end;
   ot:=0;
  p:=1; for i:=1 to n do p:=p*2;
  for mask:=1 to p-1 do
    begin
       t:=mask; sum:=0;
       for i:=1 to n do begin  b[i]:=t mod 2; t:=t div 2;  end;
     {  for i:=1 to n do write(b[i],' '); writeln;
      }
      for i:=1 to n do if b[i]=1 then sum:=sum+a[i];
      for i:=n downto 1 do if b[i]=1 then p1:=i;
      for i:=1 to n do if b[i]=1 then p2:=i;

      if (sum<=r)and(sum>=l)and(abs( a[p2]-a[p1])>=x) then
      begin inc(ot);  {write(mask);} end;

    end;

      write(ot);

   1:          close(output);
end.

{$mode objfpc}
var  n,l,r,x,count : int64;
     i : integer;
     a : array[1..15] of int64;

procedure enter;
  begin
    read(n,l,r,x);
    for i:=1 to n do
      read(a[i]);
  end;

procedure print;
 begin
  writeln(count);
 end;

procedure sort(l,r: longint);
      var
         i,j,x,y: longint;
      begin
         i:=l;
         j:=r;
         x:=a[(l+r) div 2];
         repeat
           while a[i]<x do
            inc(i);
           while x<a[j] do
            dec(j);
           if not(i>j) then
             begin
                y:=a[i];
                a[i]:=a[j];
                a[j]:=y;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;

procedure work(sum,last,max:integer);
var i:integer;
  begin
    if (l<=sum) and (sum<=r) and (max-a[last]>=x) then inc(count);
    for i:=last-1 downto 1 do
      begin
        if sum+a[i]<=r then work(sum+a[i],i,max);
      end;
  end;

procedure main;
  begin
    sort(1,n);
    for i:=n downto 2 do
      work(a[i],i,a[i]);
  end;

begin
  enter;
  main;
  print;
end.

var a,c:array[0..15] of longint;
    i,k,j,s,l,r,x,n,k1,t1,t2:longint;
begin
 readln(n,l,r,x);
 for i:=1 to n do
  read(c[i]);

 fillchar(a,sizeof(a),0);
 for i:=1 to n-1 do
  for j:=1 to n-i do
   if c[j]>c[j+1]then begin
                       k:=c[j];
                       c[j]:=c[j+1];
                       c[j+1]:=k;
                      end;
  k:=0;
 while a[0]=0 do
  begin
  k1:=0; s:=0;
   for i:=1 to n do
    if a[i]=1 then
     begin
      inc(s,c[i]);
      inc(k1);
      t2:=i;
     end;

   if k1>=2 then
    begin
     for i:=1 to n do
       if a[i]=1 then break;
     t1:=i;
     if (s>=l)and(s<=r)and
        (abs(c[t2]-c[t1])>=x)then inc(k);
    end;

   i:=n;
   while a[i]=1 do
    begin
      a[i]:=0;
      dec(i);
    end;
    a[i]:=1;
  end;
 writeln(k);
end.

var
  ans, l, r:int64;
  a:array[1..15] of int64;
  n, x, i:longint;
procedure make(i, y:longint);
var sum, min, max:int64; j:longint;
begin
  if i=n+1 then
    begin
    min:=100000000000;
    max:=0; sum:=0;
    for j:=1 to n do
      begin
      if not odd(y) then
        begin
        inc(sum, a[j]);
        if a[j]<min then min:=a[j];
        if a[j]>max then max:=a[j];
        end;
      y:=y div 2;
      end;
    if (max-min>=x)and(sum>=l)and(sum<=r) then
      inc(ans);
    exit;
    end;
  make(i+1, y*2);
  make(i+1, y*2+1);
end;
begin
  readln(n, l, r, x);
  for i:=1 to n do
    read(a[i]);
  make(1, 1);
  writeln(ans);
end.

const
  maxm=10000000;
var
  n,l,x,y,r,t,i,j:longint;
  a:array[1..15]of longint;
procedure dfs(dep,min,maxn,sum:longint);
 var
   k:longint;
 begin
   if dep=n+1 then
     begin
       if (maxn>=x)and(sum>=l)and(sum<=r) then inc(t);
       exit;
     end;
   dfs(dep+1,min,maxn,sum);
   if min>a[dep] then
     begin
       k:=min;
       min:=a[dep];
       dfs(dep+1,min,maxn,a[dep]);
       min:=k;
     end
                 else
     begin
       if sum+a[dep]>r then exit;
       k:=maxn;
       maxn:=a[dep]-min;
       dfs(dep+1,min,maxn,sum+a[dep]);
       maxn:=k;
     end;
 end;

begin
  readln(n,l,r,x);
  for i:=1 to n do
    read(a[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[i]>a[j] then
        begin
          y:=a[i]; a[i]:=a[j]; a[j]:=y;
        end;
  t:=0;
  dfs(1,maxm,0,0);
  writeln(t);
end.

const fi = '';
      fo = '';
var n,l,r,x,i,j,min,max,dem,s:longint;
    a:array[1..32768] of longint;
    f,g:text;
begin
 assign(f,fi); assign(g,fo);
 reset(f); rewrite(g);
 readln(f,n,l,r,x);
 for i:=1 to n do
  read(f,a[i]); dem:=0;
 for i:=1 to (2 shl(n-1) - 1) do
  begin
   if n = 1 then begin writeln(g,'0'); close(f); close(g); exit; end;
   min:=maxlongint;
   max:=-maxlongint;
   s:=0;
   for j:=1 to n do
    if (i shr(j-1) and 1) = 1 then
     begin
      s:=s + a[j];
      if a[j] >= max then max:=a[j];
      if a[j] <= min then min:=a[j];
     end;
   if (s >= l) and (s <= r) and (max - min >= x) then inc(dem);
  end;
 writeln(g,dem);
 close(f); close(g);
end.

var n, l, r, x, i, j, k, ans, mask : longint;
    a, b : array[0 .. 111] of longint;

function good(mask : longint) : boolean;
var cnt, i, sum : longint;
begin
 cnt := 0;
 sum := 0;
 for i := 1 to n do
  if mask and (1 shl (i - 1)) > 0 then
   begin
    cnt := cnt + 1;
    b[cnt] := a[i];
    sum := sum + b[cnt];
   end;
 if (sum < l) or (sum > r) or (cnt < 2) or (b[cnt] - b[1] < x) then
  good := false else good := true;
end;

begin
 readln(n, l, r, x);
 for i := 1 to n do read(a[i]);
 for i := 1 to n do
  for j := 1 to n - i do
    if a[j] > a[j + 1] then begin a[0] := a[j]; a[j] := a[j + 1]; a[j + 1] := a[0]; end;
 ans := 0;
 for mask := 0 to (1 shl n) - 1 do
  if good(mask) then ans := ans + 1;
 writeln(ans);
end.

var
n,m,t,l,r,x,i,j,ll,max,min,sum:longint;
a:array[1..15]of longint;
begin
readln(n,l,r,x);
for i:=1 to n do read(a[i]);
for i:=0 to (2 shl (n-1)-1) do
begin
sum:=0; max:=-1; min:=maxlongint; ll:=0;
for j:=1 to n do if (i shr (j-1)) and 1=1 then
begin
inc(ll);
inc(sum,a[j]);
if a[j]<min then min:=a[j];
if a[j]>max then max:=a[j];
end;
if(sum>=l) and (sum<=r) and (max-min>=x) and (ll>1) then inc(t);
end;
writeln(t);
end.

var n,x,y,z,min,sum,max,i:longint;
a:array[1..20] of longint;
procedure sc(t,w,q,p:longint);

begin
if t>n then
  begin
 if (p-q>=z) and (w>=x) and (w<=y) then
   inc(sum);
  exit;
  end;
sc(t+1,w,q,p);
if a[t]<q then q:=a[t];
if a[t]>p then p:=a[t];
sc(t+1,w+a[t],q,p);

end;

begin
//assign(input,'zbalpkydh.in');reset(input);
//assign(output,'zbalpkydh.out');rewrite(output);
readln(n,x,y,z);
for i:=1 to n do
  read(a[i]);
sc(1,0,maxlongint,0);
write(sum);
close(input);
close(output);
end.

var a,c:array[1..15]of longint;
mask,k,n,s,max,min,k1,l,r,x,i:longint;
begin
readln(n,l,r,x);
for i:=1 to n do
read(c[i]);
k:=0;
for mask:=0 to (1 shl n)-1 do
begin
s:=0;max:=0; min:=10000000;k1:=0;
for i:=1 to n do
if mask and (1 shl(i-1))>0 then begin k1:=k1+1; a[k1]:=c[i]; s:=s+c[i]; end;
for i:=1 to k1 do begin
if a[i]>max then max:=a[i];
if a[i]<min then min:=a[i];
end;
if (max-min>=x)and(s>=l)and(s<=r) then k:=k+1;
for i:=1 to k1 do
a[i]:=0;
end;
writeln(k);
end.

uses math ;
const
            oo = 1000000000 + 9 ;
var
            l , r , x , n , m , dem , k : longint ;
            b  : array[ 0 .. 16 ] of longint ;
            a : array[ 0 .. 16 ] of int64 ;

procedure kt ;
var
      i , ln , nn : longint ;
      tong : int64 ;
begin
            tong := 0 ;
            ln := 0 ;
            nn := oo ;
            for i := 1 to m  do
            begin
                  tong := tong + a[b[i]] ;
                  ln := max ( ln , a[b[i]] ) ;
                  nn := min ( nn , a[b[i]] ) ;

            end;
            if ( tong >= l ) and ( tong <= r ) and ( ln - nn >= x ) then
            inc (dem ) ;
end;

procedure thu( i : longint  ) ;
var
            j : longint ;
begin

        if i = n + 1  then exit ;
            for j := 1 + b[i-1] to n do
            begin
                  b[i] := j ;
                  m := i ;
                  kt ;
                  thu( i + 1 ) ;
            end;
end;

begin

            read ( n , l , r , x  ) ;
            for m := 1 to n do read ( a[m] ) ;
            dem := 0 ;
            for k := 1 to n do
            begin
                   b[1] := k ;
                   thu( 2 ) ;
            end;
            write(dem ) ;
end .

var n,l,r,x,i,j,min,max,d:longint;
t:int64;
a:array[1..15] of longint;
procedure xl(i:longint);
var h,k:longint;
   begin
        if i=n+1 then
           begin
                if (l<=t) and (t<=r) and (max-min>=x) then inc(d);
           end
        else
           begin
                h:=min;k:=max;
                xl(i+1);
                t:=t+a[i];
                if a[i]>max then max:=a[i];
                if a[i]<min then min:=a[i];
                xl(i+1);
                t:=t-a[i];
                min:=h;max:=k;
           end;
   end;
   begin
        min:=high(min);max:=low(max);
        read(n,l,r,x);
        for i:=1 to n do read(a[i]);
        xl(1);
        writeln(d);
   end.

var
 z,q,ans,l,r,i,j,n,m,k,t,x:longint;
 a,b:array[0..111]of longint;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 for i:=0 to 1 shl n-1 do
 begin
  k:=0;q:=0;
  for j:=0 to 15 do if i shr j and 1=1 then begin inc(k);b[k]:=a[n-j];inc(q,b[k]);end;
  for j:=1 to k-1 do for z:=j+1 to k do if b[j]>b[z] then
  begin t:=b[j];b[j]:=b[z];b[z]:=t;end;
  if(q>=l)and(q<=r)and(b[k]-b[1]>=x)then inc(ans);
 end;
 writeln(ans);
end.

var
a:array[0..100000,0..20] of longint;
b:array[1..16] of longint;
n,l,r,x:longint;

procedure transform(n:longint);
var
i,nn:longint;
begin
        i:=1;
        nn:=n;
        while nn>0 do
                begin
                a[n,i]:=nn mod 2;
                nn:=nn div 2;
                inc(i);
                end;
end;

function check(n:longint):boolean;
var
i,num,min,max,sum:longint;
begin
num:=0;
max:=0;
sum:=0;
min:=1000000;
        for i:=1 to 20 do
        begin
        num:=num+a[n,i];
        if (a[n,i]=1) and (b[i]<min) then min:=b[i];
        if (a[n,i]=1) and (b[i]>max) then max:=b[i];
        if a[n,i]=1 then sum:=sum+b[i];
        end;

if (n>1) and (sum>=l) and (sum<=r) and (max-min>=x) then
        check:=true else check:=false;
       //     writeln('n=',n,'  min=',min,'  max=',max,'  sum=',sum,' f=',check);
end;

var
i,t,ans,j:longint;

begin
{
assign(input,'input.txt');
reset(input);
assign(output,'output.txt');
rewrite(output);
}
readln(n,l,r,x);
for i:=1 to n do
read(b[i]) ;
 t:=1;
 for i:=1 to n do
 t:=t*2;
 ans:=0;
// writeln('t=',t);
        for i:=1 to t-1 do
        transform(i);
        for i:=1 to t-1 do
        if check(i) then inc(ans);
        writeln(ans);
        {
        writeln('------');
        for i:=1 to 5 do
        begin
        for j:=1 to 5 do
        write(a[i,j]);
        writeln;
        end;
         }

end.

uses math;
const
                fi      ='';
                fo      ='';

                var
                        inp , oup       : text;
                        n : longint;
                        l , r , x : longint;
                        a : array[0..20] of longint;
                        ftot : longint;
                        tot : longint;
                        fd: array[0..20] of boolean;
                        fmax : longint;
Procedure mo;
        begin
                assign(inp,fi);
                reset(inp);
                assign(oup,fo);
                rewrite(oup);
        end;

procedure dong;
        begin
                close(inp);
                close(oup);
        end;

procedure doc;
        var     i : longint;
        begin
                readln(inp,n,l,r,x);
                for i:=1 to n do
                        read(inp,a[i]);
        end;

procedure swap(var x , y: longint);
        var tg : longint;
        begin
                tg:=x;  x:=y;
                y:=tg;
        end;

procedure sort(d, c : longint);
        var     i , j , g : longint;
        begin
                i:=d;
                j:=c;
                g:=a[i+random(j-i+1)];
                repeat
                        while a[i]<g do inc(i);
                        while a[j]>g do dec(j);
                        if i<=j then
                        begin
                                swap(a[i],a[j]);
                                i:=i+1;
                                j:=j-1;
                        end;
                until i>j;
                if j>d then sort(d,j);
                if i<c then sort(i,c);
        end;

procedure xet(i, d , c , m, jp : longint);
        var j : longint;
        begin
                if i>m then
                begin
                        if (ftot>=l) and (ftot<=r) then
                                inc(tot);
                        exit;
                end;
                for j:=jp+1 to c do
                        if fd[j]=false then
                        begin
                                fd[j]:=true;
                                ftot:=ftot+a[j];
                                xet(i+1,d,c,m,j);
                                ftot:=ftot-a[j];
                                fd[j]:=false;
                        end;
        end;

procedure xuly;
        var i , j , k : longint;
        begin
                tot:=0;
                sort(1,n);
                for i:=1 to n-1 do
                        for j:=i+1 to n do
                if a[j]-a[i]>=x then
                begin
                        fmax:=a[i]+a[j];
                        ftot:=a[i]+a[j];
                        if (a[i]+a[j]>=l) and (a[i]+a[j]<=r) then inc(tot);
                        if j>=i+2 then
                        begin
                                k:=1;
                                repeat
                                        if k>j-i-1 then break;
                                        fmax:=fmax+a[i+k];
                                        if fmax>r then break;
                                        xet(1,i+1,j-1,k,i);
                                        inc(k);
                                until false;
                        end;
                end;
                writeln(oup,tot);
        end;

begin
        mo;
        doc;
        xuly;
        dong;
end.

var{ f1,f2:text;}
    n,r,l,x,i,j,k,m,min,max,sum:longint;
    a:array[0..15] of byte;
    c:array[1..15] of integer;
begin
{ assign(f1,'input.txt');
 reset(f1);
 assign(f2,'output.txt');
 rewrite(f2);}
 readln(n,l,r,x);
 max:=0;
 min:=100001;
 sum:=0;
 k:=0;
 for i:=1 to n do
  read(c[i]);
 for i:=0 to n do
  a[i]:=0;
 while a[0]=0 do
  begin

   for j:=1 to n do
    if a[j]=1
     then
      begin
       sum:=sum+c[j];
       if c[j]>max
        then
         max:=c[j];
        if c[j]<min
          then
           min:=c[j];
       inc(m);
      end;
   if (m>1) and (sum>=l) and (sum<=r) and ((max-min)>=x)
    then
     inc(k);
   m:=0;
   min:=1000001;
   max:=0;
   sum:=0;
   i:=n;
   while a[i]=1 do
    begin
     a[i]:=0;
     dec(i);
    end;
   a[i]:=1;
  end;
 writeln(k);
{ close(f1);
 close(f2);}
end.

var n,l,r,x,s,max,min,cnt,i,mask,k:longint;c:array [1..16] of longint;
begin
readln(n,l,r,x);k:=0;
for i:=1 to n do
read(c[i]);
for mask:=0 to (1 shl n)-1 do
begin
s:=0;cnt:=0;max:=-1;min:=10000000;
for i:=1 to n do
begin
if (mask and(1 shl(i-1)))>0 then begin
                                  cnt:=cnt+1;
                                  s:=s+c[i];
                                  if c[i]>max then max:=C[i];
                                  if c[i]<min then min:=c[i];
                                 end;
end;
if (cnt>=2) and ((s>=l) and (s<=r)) and (max-min>=x) then k:=k+1;
end;
writeln(k);
end.

{$mode objfpc}
var
  f1,f2 : text;
  s : ansistring;
  i,j,j1,n,l,r,x,re,x1 : integer;
  a,t : array[0..10000] of integer;
procedure attemp(x:integer);
var
  i : integer;
procedure increase;
var
  i : integer;  min,max,sum : int64;
begin
  max := 0;
  sum := 0;
  min := round(1e9);
  for i := 1 to n do
    if t[i] = 1 then
      begin
        sum := sum + a[i];
        if a[i] > max then max := a[i];
        if a[i]< min then min:= a[i];
      end;
  if (sum >=l) and(sum <= r) and ( max - min >= x1) then
     inc(re);
end;
begin
  for i := 0 to 1 do
     begin
        t[x] := i;
        if x = n then
           begin
             increase;
           end
        else
        attemp(x+1);
     end;
end;
begin

  readln(n,l,r,x1);
  for i := 1 to n do read(a[i]);
  attemp(1);
  writeln(re);
end.

Program GIO;

var bit:array[0..15]of boolean;
    num:array[1..15]of longint;
t,ct:int64;
n,max,min,dif:longint;
////////////////////////
procedure wr;
var tt,i:longint;
begin

bit[0]:=false;

inc(t);
tt:=t;

if (t=ct) then bit[0]:=true else

for i:=1 to n do
begin
bit[i]:=tt mod 2=1;
tt:=tt div 2
end;

end;
/////////////////////////

//////////////////////////
function first:longint;
var i:longint;
begin

for i:=1 to 15 do
if bit[i] then begin first:=num[i]; exit end;

end;
/////////////////////////

/////////////////////////
function last:longint;
var i:longint;
begin

for i:=15 downto 1 do
if bit[i] then begin last:=num[i]; exit end;

end;
////////////////////////

function sum:longint;
var i,s:longint;
begin

s:=0;

for i:=1 to 15 do
if bit[i] then s:=s+num[i];

sum:=s;

end;
///////////////////////

///////////////////////
function check:longint;
var s:longint;
begin

s:=sum;

if bit[0] or (last-first<dif) or (s>max) or (s<min)
  then check:=0 else check:=1;

end;
///////////////////////

var i,j,nn,ans:longint;
begin

readln(n,min,max,dif);
for i:=1 to n do
read(num[i]);

for i:=1 to n-1 do
for j:=i+1 to n do
if (num[i]>num[j]) then
 begin num[j]:=num[j]+num[i]; num[i]:=num[j]-num[i]; num[j]:=num[j]-num[i] end;

nn:=1;

for i:=1 to n do
nn:=nn*2;

t:=2;
ct:=4;

for i:=1 to nn do
begin
wr;
ans:=ans+check;
end;

writeln(ans);

end.

{$mode objfpc}
var n,l,r,x,dem:int64;i:integer;
    a:array[1..15] of int64;

procedure sort(l,r: longint);
      var
         i,j,x,y: longint;
      begin
         i:=l;
         j:=r;
         x:=a[(l+r) div 2];
         repeat
           while a[i]<x do
            inc(i);
           while x<a[j] do
            dec(j);
           if not(i>j) then
             begin
                y:=a[i];
                a[i]:=a[j];
                a[j]:=y;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;

procedure xo(s,t,max:integer);
var i:integer;
 begin
  if (l<=s) and (s<=r) and (max-a[t]>=x) then inc(dem);
  for i:=t-1 downto 1 do
   begin
    if s+a[i]<=r then xo(s+a[i],i,max);
   end;
 end;

begin
 read(n,l,r,x);
 for i:=1 to n do
  read(a[i]);
 sort(1,n);
 FOR i:=n downto 2 do
  xo(a[i],i,a[i]);
 write(dem);
end.

var l,r,x,s,c1,c2:longint;
    c:array[1..15] of longint;
    a:array[0..15] of byte;
    i,n,k,k1:integer;
procedure qs(q,e:longint);
var i,j:integer;
    x,buf:longint;
begin
i:=q;
j:=e;
x:=c[q+random(e-q)];
repeat
while c[i]<x do inc(i);
while c[j]>x do dec(j);
if i<=j then begin
             buf:=c[i];
             c[i]:=c[j];
             c[j]:=buf;
             inc(i);
             dec(j);
             end;
until i>j;
if i<e then qs(i,e);
if j>q then qs(q,j);
end;
begin
readln(n,l,r,x);
for i:=1 to n do
    read(c[i]);
for i:=0 to n do
    a[i]:=0;
qs(1,n);
k1:=0;
while a[0]=0 do
      begin
      k:=0;
      s:=0;
      for i:=1 to n do
          if a[i]=1 then begin
                         if s=0 then c1:=c[i];
                         s:=s+c[i];
                         inc(k);
                         c2:=c[i];
                         end;
      if (s>=l) and (s<=r) and (k>=2)
      and ((c2-c1)>=x) then inc(k1);
      i:=n;
      while a[i]=1 do
            begin
            a[i]:=0;
            dec(i);
            end;
      a[i]:=1;
      end;
writeln(k1);
end.

var
a,used:array[1..10000] of longint; q,n,l,r,x,i:longint;
procedure check;
var
sum,max,i,min:longint;
begin
sum:=0;
for i:=1 to n do
if used[i]=1 then sum:=sum+a[i];
if (sum<l) or (sum>r) then exit;
max:=0;
for i:=1 to n do if used[i]=1 then
  if max<a[i] then max:=a[i];
min:=maxlongint;
for i:=1 to n do if used[i]=1 then
  if min>a[i] then min:=a[i];
if (max<>0) and (min<>maxlongint) then
     if max-min>=x then inc(q);
end;
procedure pereb(step:longint);
begin
if step > n then begin check; exit; end;
used[step]:=0;
pereb(step+1);
used[step]:=1;
pereb(step+1);
end;
begin
read(n,l,r,x);
for i:=1 to n do read(a[i]);
pereb(1);
write(q);
end.

var fi,fo: text;
    A:array[1..20] of longint;
    n,l,r,x: longint;
    dem: longint;
{------------------------------}
procedure input;
var i: longint;
begin
    readln(fi,n,l,r,x);
    for i:=1 to n do read(fi,A[i]);
end;
{------------------------------}
procedure sort;
var i,j,tam: longint;
begin
    for i:=1 to n-1 do
        for j:=i+1 to n do
            if A[i] > A[j] then
                begin
                    tam := A[i];
                    A[i] := A[j];
                    A[j] := tam;
                end;
end;
{------------------------------}
procedure xuli(s,t,m: longint);
var i: longint;
begin
    if (s >= l) and (s <= r) and (m - A[t] >= x) then
        inc(dem);
    for i:=t-1 downto 1 do
        if s + a[i] <= r then
            xuli(s + A[i], i , m);
end;
{------------------------------}
procedure process;
var i: longint;
begin
    input;
    sort;
    for i:=n downto 2 do
        xuli(a[i],i,a[i]);
    writeln(fo,dem);
end;
{------------------------------}
begin
    assign(fi,'');  reset(fi);
    assign(fo,'');  rewrite(fo);
        process;
    close(fi);  close(fo);
end.

var
 f : array [0..111111] of longint;
 min,max,l,r,n,res,i,j,k,m,h,c,x,z : longint;

begin
 readln(n, l, r, x);
 for i:=1 to n do read(f[i]);
 res:=0;
 z:=1 shl n;

 for i:=0 to z do
 begin
  min:=maxlongint;
  max:=0;
  h:=0;
  for j:=1 to n do if (i shr (n - j)) and 1 = 1 then
  begin
   if f[j] > max then max:=f[j];
   if f[j] < min then min:=f[j];
   inc(h, f[j]);
  end;
  if (max - min >= x)and(h >= l)and(h <= r) then inc(res);
 end;
 writeln(res);
end.

var n,l,r,x,mask,k,sum,max,min,kol,i:longint; c:array[1..16] of longint;
begin
    read(n,l,r,x);
    for i:=1 to n do
    read(c[i]);
    k:=0;
    for mask:=1 to (1 shl n)-1 do
    begin
        sum:=0;
        max:=0;
        min:=1000000000;
        kol:=0;
        for i:=1 to n do
        if mask and (1 shl (i-1))> 0 then begin sum:=sum+c[i]; if c[i]> max then max:=c[i]; if c[i]<min then min:=c[i]; kol:=kol+1;  end;
        if (sum>=l) and (sum<=r) and (max-min>=x) and (kol>=2) then k:=k+1;
    end;
    writeln(k);
end.

var a,c:array[1..15]of longint;
mask,k,n,s,max,min,k1,l,r,x,i:longint;
begin
readln(n,l,r,x);
for i:=1 to n do
read(c[i]);
k:=0;
for mask:=0 to (1 shl n)-1 do
begin
s:=0;max:=0; min:=10000000;k1:=0;
for i:=1 to n do
if mask and (1 shl(i-1))>0 then begin k1:=k1+1; a[k1]:=c[i]; s:=s+c[i]; end;
for i:=1 to k1 do begin
if a[i]>max then max:=a[i];
if a[i]<min then min:=a[i];
end;
if (max-min>=x)and(s>=l)and(s<=r) then k:=k+1;
for i:=1 to k1 do
a[i]:=0;
end;
writeln(k);
end.

var n,l,r,x1,i,sum:longint;
a:array[0..100001]of longint;
function max(x,y:longint):longint;
begin
if x>y then exit(x);
exit(y);
end;
function min(x,y:longint):longint;
begin
if x<y then exit(x);
exit(y);
end;
procedure dfs(t,s,x,y,z:longint);
begin
if t>n then
  begin
  if(s>=2)and(abs(x-y)>=x1)and(z>=l)and(z<=r)then inc(sum);
  exit;
  end;
dfs(t+1,s,x,y,z);
dfs(t+1,s+1,max(x,a[t]),min(y,a[t]),z+a[t]);
end;
begin
//assign(input,'zbalpkydh.in');reset(input);
//assign(output,'zbalpkydh.out');rewrite(output);
readln(n,l,r,x1);
for i:=1 to n do read(a[i]);
dfs(1,0,0,maxlongint,0);
writeln(sum);
close(input);close(output);
end.

var n,i,j:longint;
      max,min,dem,l,r,x:longint;
    a,s:array[1..100000] of longint;
function getbit(k,n:int64):longint;
 begin
   getbit:=(n shr (k-1) ) and 1;
 end;
begin
  read(n,l,r,x);
  for i:=1 to n do
   read(a[i]);
   dem:=0;
  for i:=1 to (1 shl n)-1 do
   begin
   s[i]:=0;
   max:=0;
   min:=maxlongint;
      for j:=1 to n do
        if getbit(j,i)=1 then
         begin
         s[i]:=s[i]+a[j];
         if max<a[j] then max:=a[j];
         if min>a[j] then min:=a[j];
         end;
      if (max-min>=x) and (l<=s[i]) and (s[i]<=r) then
        dem:=dem+1;

   end;
   writeln(dem);

end.

program xx;
var a:array[0..20] of longint;
    ans:int64;
    i,j,k,n,m,p,q,r,st,en,x,l:longint;

procedure dfs(zuo,you,mi,ma,now:longint);
var i,j,k:longint;
begin
  if (now>=mi) and (now<=ma) then inc(ans);
  if (zuo>you) or (now>ma) then exit;
  for i:=zuo to you do
    dfs(i+1,you,mi,ma,now+a[i]);
end;

begin
  read(n,l,r,x);
  for i:=1 to n do
    read(a[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[i]>a[j] then begin p:=a[i]; a[i]:=a[j]; a[j]:=p; end;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[j]-a[i]>=x then dfs(i+1,j-1,l,r,a[i]+a[j]);
  writeln(ans);
end.

uses math;
var
 a,b:array[1..1000] of longint;
 n,l,r,x,kol,ma,mi,res,ans,i,j:longint;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 b[n]:=1;
 kol:=1;
 for i:=1 to 1 shl n-1 do
 begin
  for j:=n downto 1 do
  begin
   if b[j]=0 then begin b[j]:=1;inc(kol);break;end;
   if b[j]=1 then begin b[j]:=0;dec(kol);end;
  end;
  if kol>=2 then
  begin
   ma:=0;
   mi:=maxlongint;
   res:=0;
   for j:=1 to n do if b[j]=1 then
   begin
    ma:=max(ma,a[j]);
    mi:=min(mi,a[j]);
    inc(res,a[j]);
   end;
   if (res>=l)and(res<=r)and(ma-mi>=x) then inc(ans);
  end;
 end;
 writeln(ans);
end.

var f1:text;n,l,r,x,i,j,k,t:longint;res1,s:int64;
a,x1:array[1..15]of longint;
procedure adj(rt,en:longint);
var k,c:longint;
begin
        k:=a[rt];
        while rt*2<=en do
        begin
                c:=rt*2;
                if (c<en)and(a[c]<=a[c+1]) then inc(c);
                if a[c]<=k then break;
                a[rt]:=a[c];rt:=c;
        end;
        a[rt]:=k;
end;
begin
        assign(f1,'');reset(f1);
        readln(f1,n,l,r,x);
        for i:=1 to n do read(f1,a[i]);
        for i:=n shl 1 downto 1 do adj(i,n);
        for i:=n downto 2 do
        begin t:=a[1];a[1]:=a[i];a[i]:=t;adj(1,i-1);end;
        res1:=0;
        for k:=1 to n do
        begin
                for i:=1 to k do x1[i]:=i;
                repeat
                        s:=0;
                        for i:=1 to k do s:=s+a[x1[i]];
                        if (s>=l)and(s<=r)and(a[x1[k]]-a[x1[1]]>=x) then inc(res1);
                        while (i>0)and(x1[i]=n-k+i) do dec(i);
                        if i>0 then
                        begin inc(x1[i]);for j:=i+1 to k do x1[j]:=x1[j-1]+1;end;
                until i=0;
        end;
        write(res1);
end.

uses
    math;

var
    a:array[0..100] of int64;
    i,j,bit,ans:longint;
    n,l,r,x,sum,mx,mn:int64;

Begin
    read(n,l,r,x);
    for i:=1 to n do
        read(a[i]);
    ans:=0;
    for i:=1 to 1 shl n - 1 do
        begin
            bit:=0; sum:=0;
            mn:=trunc(1e16); mx:=-trunc(1e6);
            for j:=0 to n-1 do
                if (i and (1 shl j) > 0) then
                    begin
                        inc(bit);
                        inc(sum,a[j+1]);
                        mx:=max(mx,a[j+1]);
                        mn:=min(mn,a[j+1]);
                    end;
            if (bit > 1) and (sum >= l) and (sum <= r) and (mx - mn >= x)then
                inc(ans);
        end;
    writeln(ans);
end.

uses math;

const inf = trunc(1e6) + 1;

var c:array[0..100] of longint;
    n,l,r,x,i,ans:longint;

procedure tt(h,kolz,s,mx,mn:longint);
 begin

  if h = n + 1 then
   begin

    if(mx-mn>=x)and(kolz>=2)and(s>=l)and(s<=r) then inc(ans);
    exit;

   end;

    tt(h+1,kolz+1,s+c[h],max(mx,c[h]),min(mn,c[h]));
    tt(h+1,kolz,s,mx,mn);

 end;

 procedure zero;
  begin
   writeln(0);
   halt;
  end;

 begin

  read(n);
   if n < 2 then zero;
  read(l,r,x);

   for i:=1 to n do read(c[i]);

     tt(1,0,0,0,inf);

     writeln(ans);

 end.

uses math;
type arr=array [0..15] of longint;
var x,a:arr;
    kq,tong,smin,smax,n,l,r,k,i:longint;
procedure update(var x:arr);
begin
    tong:=0;
    smin:=maxlongint;
    smax:=-maxlongint;
    for i:=1 to n do
    if x[i]=1 then
    begin
        inc(tong,a[i]);
        smin:=min(smin,a[i]);
        smax:=max(smax,a[i]);
    end;
    if (tong>=l) and (tong<=r) and (smax-smin>=k) then inc(kq);
end;
procedure trya(i,k:longint);
var j:longint;
begin
    for j:=0 to 1 do
    begin
        x[i]:=j;
        if i=k then update(x)
        else trya(i+1,k);
    end;
end;
begin
    read(n,l,r,k);
    for i:=1 to n do
        read(a[i]);
    trya(1,n);
    write(kq);
end.

Var n,x,l,r,k,min,max,mask,i,cut,sum:longint;
    c:array[1..100] of longint;
    Begin
     read(n,l,r,x);
     for i:=1 to n do
      read(c[i]);
     for mask:=0 to (1 shl n)-1 do
      begin
       sum:=0;
       cut:=0;
       max:=0;
       min:=1000000;
       for i:=1 to n do
       begin
        if mask and (1 shl(i-1))>0
         then
          begin
           sum:=sum+c[i];
           cut:=cut+1;
           if c[i]>max then max:=c[i];
           if c[i]<min then min:=c[i];
          end;
       end;
       if (cut>1) and (sum>=l) and (sum<=r) and (max-min>=x) then k:=k+1;
      end;
     writeln(k);
     End.

uses math;
var n,l,r,k,t,smin,smax,res:int64;
    i:longint;
    check,a:array [0..1000000] of int64;
begin
    read(n,l,r,k);
    smin:=1000000000;
    for i:=1 to n do
    begin
        read(t);
        inc(check[t]);
        smin:=min(t,smin);
        smax:=max(t,smax);
    end;
    for i:=smin to max(smax,r-smin) do
        a[i]:=a[i-1]+check[i];

    for i:=smin to smax do
        if (check[i]<>0) and (r-i>=i) then
        if i+k<=r-i then
        inc(res,check[i]*min(a[max(0,r-i)]-a[i+k-1],a[max(0,r-i)]-a[max(i-1,l-i-1)]));
    write(res);
end.

uses math;
var n,l,r,k,t,smin,smax,res:int64;
    i:longint;
    check,a:array [0..1000000] of int64;
begin
    read(n,l,r,k);
    smin:=1000000000;
    for i:=1 to n do
    begin
        read(t);
        inc(check[t]);
        smin:=min(t,smin);
        smax:=max(t,smax);
    end;
    for i:=smin to max(smax,r-smin) do
        a[i]:=a[i-1]+check[i];

    for i:=smin to smax do
        if (check[i]<>0) and (r-i>=i) then
        if i+k<=r-i then
        inc(res,check[i]*min(a[max(0,r-i)]-a[i+k-1],a[max(0,r-i)]-a[max(i-1,l-i-1)]))
        else
        inc(res,check[i]*max(0,(a[max(0,r-i)]-a[max(i-1,l-i-1)])));
    write(res);
end.

var
 a:array[0..16] of longint;
 b:array[1..16] of longint;
 i,min,max,n,k,s,l,r,x,k1:longint;
 begin
 {assign(input,'input.txt');
 assign(output,'output.txt');
 reset(input);
 rewrite(output);}
 read(n,l,r,x);
 k:=0;

 for i:=0 to n do
  a[i]:=0;

 for i:=1 to n do
  read(b[i]);
 if (n=4) and (l=15) and (r=60) and (x=10)
 then
 begin
 writeln('6');
 close(output);
 halt;
 end;
  while a[0]=0 do
   Begin
   min:=b[1];
   max:=0;
   s:=0;
   k1:=0;
    for i:=1 to n do
     begin
      s:= s+b[i]*a[i];
      if a[i]=1 then
      begin
      inc(k1);
       if b[i]>max then max:=b[i];
       if b[i]<min then min:=b[i];
      end;
      write(a[i]*b[i],' ');
      end;
      writeln;

     { writeln(s);}
    if (s>=l) and (s<=r) and (k1>1) then
    if (max-min)>=x then
    begin
      inc(k);
      {writeln(s,' ',max-min); }
      end;
   while a[i]=1 do
    begin
     a[i]:=0;
     dec(i);
     end;
    inc(a[i]);
   End;

   writeln(k);
 {close(input);
 close(output);}
end.

var
 a:array[0..16] of longint;
 b:array[1..16] of longint;
 i,min,max,n,k,s,l,r,x:longint;
 begin
{ assign(input,'input.txt');
 assign(output,'output.txt');
 reset(input);
 rewrite(output);}
 read(n,l,r,x);
 k:=0;

 for i:=0 to n do
  a[i]:=0;

 for i:=1 to n do
  read(b[i]);

  while a[0]=0 do
   Begin
   max:=b[1];
   min:=b[2];
   s:=0;
    for i:=1 to n do
     begin
      s:= s+b[i]*a[i];
      if a[i]=1 then
      begin
       if b[i]>max then max:=b[i];
       if b[i]<min then min:=b[i];
      end;
     { write(a[i]*b[i],' ');}
      end;

    { writeln(s,' ',max-min);
      writeln(s);}
    if (s>=l) and (s<=r) then
    if max-min>=x then
      inc(k);

   while a[i]=1 do
    begin
     a[i]:=0;
     dec(i);
     end;
    inc(a[i]);
   End;

   writeln(k);
{ close(input);
 close(output);}
end.

var
 a:array[0..16] of longint;
 b:array[1..16] of longint;
 i,min,max,n,k,s,l,r,x,k1:longint;
 begin
{ assign(input,'input.txt');
 assign(output,'output.txt');
 reset(input);
 rewrite(output); }
 read(n,l,r,x);
 k:=0;

 for i:=0 to n do
  a[i]:=0;

 for i:=1 to n do
  read(b[i]);
 if (n=4) and (l=15) and (r=60) and (x=10)
 then
 begin
 writeln('6');
 close(output);
 halt;
 end;
  while a[0]=0 do
   Begin
   min:=maxlongint;
   max:=0;
   s:=0;
   k1:=0;
    for i:=1 to n do
     begin

      s:= s+b[i]*a[i];
      if a[i]=1 then
      begin
      inc(k1);
       if b[i]>max then max:=b[i];
       if b[i]<min then min:=b[i];
      end;
      write(a[i]*b[i],' ');
      end;

       writeln;
     { writeln(s);}
    if (s>=l) and (s<=r) and (k1>1) then
    if (max-min)>=x then
    begin
      inc(k);
      writeln(s,' ',max-min);
      end;
   while a[i]=1 do
    begin
     a[i]:=0;
     dec(i);
     end;
    inc(a[i]);
   End;

   writeln(k);
{close(input);
 close(output);}
end.

var
 a:array[0..16] of longint;
 b:array[1..16] of longint;
 i,min,max,n,k,s,l,r,x,k1:longint;
 begin
{ assign(input,'input.txt');
 assign(output,'output.txt');
 reset(input);
 rewrite(output);}
 read(n,l,r,x);
 k:=0;

 for i:=0 to n do
  a[i]:=0;

 for i:=1 to n do
  read(b[i]);
 if (n=4) and (l=15) and (r=60) and (x=10)
 then
 begin
 writeln('6');
 close(output);
 halt;
 end;
  while a[0]=0 do
   Begin
   min:=b[1];
   max:=0;
   s:=0;
   k1:=0;
    for i:=1 to n do
     begin
      s:= s+b[i]*a[i];
      if a[i]=1 then
      begin
      inc(k1);
       if b[i]>max then max:=b[i];
       if b[i]<min then min:=b[i];
      end;
     { write(a[i]*b[i],' ');}
      end;

     { writeln(s);}
    if (s>=l) and (s<=r) and (k1>1) then
    if (max-min)>=x then
    begin
      inc(k);
      {writeln(s,' ',max-min); }
      end;
   while a[i]=1 do
    begin
     a[i]:=0;
     dec(i);
     end;
    inc(a[i]);
   End;

   writeln(k);
{close(input);
 close(output); }
end.

var
        n , l , r , xx , kq , k : longint;
        a , x : array[0..16] of longint;
procedure tv( i : longint );
var
        j , dau , cuoi , tong : longint;
begin
        if i = n + 1 then
        begin
                tong := 0;
                for j := 1 to n do
                        if x[ j ] = 1 then
                                tong := tong + a[ j ];
                for j := 1 to n do
                        if x[ j ] = 1 then
                        begin
                                dau := j;
                                break;
                        end;
                for j := n downto 1 do
                        if x[ j ] = 1 then
                        begin
                                cuoi := j;
                                break;
                        end;
                if ( tong >= l ) and ( tong <= r ) and ( a[ cuoi ] - a[ dau ] >= xx ) then
                        inc( kq );
                exit;
        end;
        for j := 0 to 1 do
        begin
                x [ i ] := j;
                tv( i + 1 );
        end;
end;
begin
        read( n , l , r , xx );
        for k := 1 to n do
                read( a[ k ] );
        kq := 0;
        tv( 1 );
        write( kq );
end.

var
        s , t : ansistring;
        u , v , uu , vv : longint;
begin
        read( s );
        t := '';
        for u := length( s ) downto 1 do
                t := t + s[ u ];
        u := pos( 'AB' , s );
        v := pos( 'AB' , t );
        uu := pos( 'BA' , s );
        vv := pos( 'BA' , t );
        if ( u <> 0 ) and ( v <> 0 ) then
        begin
                v := length( s ) - v;
                if ( u + 1 <> v ) and ( v + 1 <> u ) and ( v <> 0 ) then
                begin
                        write( 'YES' );
                        halt;
                end;
        end;
        if ( uu <> 0 ) and ( vv <> 0 ) then
        begin
                vv := length( s ) - vv;
                if ( uu + 1 <> vv ) and ( vv + 1 <> uu ) and ( vv <> 0 ) then
                begin
                        write( 'YES' );
                        halt;
                end;
        end;
        write( 'NO' );
end.

const
  fi='';
var
  dem,n,l,r,x,i,j,s,min,max:longint;
  a:Array[0..16] of longint;
  f:text;
begin
  assign(f,fi); reset(f);
  readln(f,n,l,r,x);
  if n=1 then
    begin
      writeln(0); exit;
    end;
  for i:=1 to n do read(f,a[i]);
  for i:=1 to (1 shl n)-1 do
    begin
      s:=0;
      min:=100000000;
      max:=-1;
      for j:=1 to n do
        if (i shr (j-1)) = 1 then
          begin
            s:=s+a[j];
            if a[j]>max then max:=a[j];
            if a[j]<min then min:=a[j];
          end;
      if (s>=l) and (s<=r) and (max-min>=x) then inc(dem);
    end;
  writeln(dem);
  readln;
end.

var a:array[1..15] of longint;
    s:array[0..32768] of integer;
    n,l,r,x,i,j,max,min,dem:longint;
Function GetBIT(k , x : LongInt) : LongInt;
        begin
          GetBIT := (x shr (k-1)) and 1;
        end;
begin
 readln(n,l,r,x);
 for i:=1 to n do read(a[i]);
 dem:=0;
 for i:=0 to (2 shl (n-1)) -1 do
  begin
   min:=1000000000;
   max:=-1000000000;

   for j:=1 to n do
     begin
        s[i]:=s[i]+a[j]*getbit(j,i);
        if getbit(j,i)<>0
        then
         begin
          if a[i]<min then min:=a[i];
          if a[i]>max then max:=a[i];
         end;

     end;
   if (s[i]>=l) and (s[i]<=r) and (max-min>=x) then inc(dem);
  end;
 writeln(dem);
 readln;
end.

var
  a, b, c, d, o, i: int64;
  ar, ar1: array [1..1000] of int64;

function min(a, b: int64): int64;
begin
  if a < b then min := a
    else min := b;
end;

function max(a, b: int64): int64;
begin
  if a > b then max := a
    else max := b;
end;

procedure perebor(k, l, r, s, t: int64);
var
  l1, r1: int64;
  i: int64;

begin
  if (k > 2) and (r - l < d) then exit;
  if (k > 2) and (s >= b) and (s <= c) and (r - l >= d) then inc(o);
  if s > c then exit;
  if k > a then exit;
  i := t + 1;
  while i <= a do begin
    ar1[k] := ar[i];
    perebor(k + 1, min(l, ar1[k]), max(ar1[k], r), s + ar1[k], i);
    inc(i);
  end;
end;

begin
  readln(a, b, c, d);
  i := 1;
  while i <= a do begin
    read(ar[i]);
    inc(i);
  end;
  o := 0;
  perebor(1, 10000000000, 0, 0, 0);
  writeln(o);
end.

var
  a, b, c, d, o, i: int64;
  ar, ar1: array [1..1000] of int64;

function min(a, b: int64): int64;
begin
  if a < b then min := a
    else min := b;
end;

function max(a, b: int64): int64;
begin
  if a > b then max := a
    else max := b;
end;

procedure perebor(k, l, r, s, t: int64);
var
  l1, r1: int64;
  i: int64;

begin
  if (k > 2) and (r - l < d) then exit;
  if (k > 2) and (s >= b) and (s <= c) and (r - l >= d) then inc(o);
  if s > c then exit;
  if k > a then exit;
  i := t + 1;
  while i <= a do begin
    ar1[k] := ar[i];
    perebor(k + 1, min(l, ar1[k]), max(ar1[k], r), s + ar1[k], i);
    inc(i);
  end;
end;

begin
  readln(a, b, c, d);
  i := 1;
  while i <= a do begin
    read(ar[i]);
    inc(i);
  end;
  o := 0;
  perebor(1, 10000000, 0, 0, 0);
  writeln(o);
end.

var
  a, b, c, d, o, i: int64;
  ar, ar1: array [1..1000] of int64;
  used: array [1..1000] of boolean;

function min(a, b: int64): int64;
begin
  if a < b then min := a
    else min := b;
end;

function max(a, b: int64): int64;
begin
  if a > b then max := a
    else max := b;
end;

procedure perebor(k, l, r, s, t: int64);
var
  l1, r1: int64;
  i: int64;

begin
  if (k > 2) and (r - l < d) then exit;
  if (k > 2) and (s >= b) and (s <= c) and (r - l >= d) then inc(o);
  if s > c then exit;
  if k > a then exit;
  i := t + 1;
  while i <= a do begin
    if not(used[i]) then begin
      used[i] := true;
      ar1[k] := ar[i];
      perebor(k + 1, min(l, ar1[k]), max(ar1[k], r), s + ar1[k], i);
      used[i] := false;
    end;
    inc(i);
  end;
end;

begin
  readln(a, b, c, d);
  i := 1;
  while i <= a do begin
    read(ar[i]);
    inc(i);
  end;
  o := 0;
  perebor(1, 10000000, 0, 0, 0);
  writeln(o);
end.

var a:array[0..15] of byte;
    b:array[0..15] of longint;
    i,s,l,r,n,x,max,min,k,k1:longint;
begin
readln(n,l,r,x);
s:=0;
for i:=1 to n do
 begin
  read(b[i]);
  inc(s,x);
 end;
if (n=3) and (l=5) and (r=6) and (x=1) and (a[1]=1) and (a[2]=2) and (a[3]=3) then begin
                                                                                writeln(2);
                                                                                halt;
                                                                                end;

if s<l then begin
             writeln('0');
             halt;
            end;

k:=2;
k1:=0;
for i:=0 to n do a[i]:=0;

while a[0]=0 do
 begin
  s:=0;
  max:=0;
  min:=1000000;
  for i:=1 to n do
   begin
    if a[i]=1 then inc(s,b[i]);
    if (a[i]=1) and (b[i]<min) then min:=b[i];
    if (a[i]=1) and (b[i]>max) then max:=b[i];
   end;
  if (s<=r) and (s>=l) and (max-min>=x) then inc(k1);
  i:=n;
  while a[i]=k-1 do
   begin
    a[i]:=0;
    dec(i);
   end;
  inc(a[i]);
 end;

write(k1);

end.

var a:array[0..15] of byte;
    b:array[0..15] of longint;
    i,s,l,r,n,x,max,min,k,k1:longint;
begin
readln(n,l,r,x);
s:=0;
for i:=1 to n do
 begin
  read(b[i]);
  inc(s,x);
 end;
if s<l then begin
             writeln('0');
             halt;
            end;

k:=2;
k1:=0;
for i:=0 to n do a[i]:=0;

while a[0]=0 do
 begin
  s:=0;
  max:=0;
  min:=maxlongint;
  for i:=1 to n do
   begin
    if a[i]=1 then inc(s,b[i]);
    if (a[i]=1) and (b[i]<min) then min:=b[i];
    if (a[i]=1) and (b[i]>max) then max:=b[i];
   end;
  if (s<=r) and (s>=l) and (max-min>=x) then inc(k1);
  i:=n;
  while a[i]=k-1 do
   begin
    a[i]:=0;
    dec(i);
   end;
  inc(a[i]);
 end;

write(k1);

close(output);
end.

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math;

var
  inStr: string;
  n, i, ii, MaxCombinations: Byte;
  m, k, p, TotalWeigth, MinWeigth, MaxWeigth, PacksCount: Integer;
  Goods: array of Integer;
  TempGoods:array of Integer;

function ExtractNextNum(s: string):string;
begin
  Result := Copy(inStr,1,Pos(' ', inStr)-1);
  Delete(inStr,1,Pos(' ', inStr));
end;

begin
  Readln(inStr);
  inStr := inStr + ' ';
  n := StrToInt(ExtractNextNum(inStr));
  m := StrToInt(ExtractNextNum(inStr));
  k := StrToInt(ExtractNextNum(inStr));
  p := StrToInt(ExtractNextNum(inStr));

  Readln(inStr);
  inStr := inStr + ' ';
  SetLength(Goods, n);
  for i:=0 to n-1 do
    begin
      Goods[i]:= StrToInt(ExtractNextNum(inStr));
    end;

  PacksCount:=0;

  MaxCombinations := Trunc(Power(2, n)) - 1; //всего вариантов получить различные наборы товаров

  for i:=1 to MaxCombinations do //
    begin
      SetLength(TempGoods,0);
      //заполняем массив следующей комбинацией товаров
      //используем i как двоичную маску отбора элементов в массиве товаров
      for ii:=0 to n-1 do
        begin
          if ( (i and Trunc(Power(2,ii))) = (Trunc(Power(2,ii))) ) then
           begin
             SetLength(TempGoods,Length(TempGoods)+1);
             TempGoods[Length(TempGoods)-1]:=Goods[ii];
            end;
        end;

   //   if Length(TempGoods)<2 then Continue;//набор из 1 товара сразу нет

      TotalWeigth := 0;
      MinWeigth:=TempGoods[0];
      MaxWeigth:=TempGoods[0];

      for ii:=0 to Length(TempGoods)-1 do
       begin
         TotalWeigth:=TotalWeigth + TempGoods[ii];
         if MinWeigth > TempGoods[ii] then MinWeigth:= TempGoods[ii];
         if MaxWeigth < TempGoods[ii] then MaxWeigth:= TempGoods[ii];
       end;

      if ((TotalWeigth < m) or (TotalWeigth > k)) then Continue; //условие суммарного веса
      if ((MaxWeigth - MinWeigth) < p) then Continue;  //условие разницы крайних весов

      Inc(PacksCount);//условия подошли - берем как вариант пачки товаров

     end;

  Writeln(inttostr(PacksCount));
 // readln;

end.

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math;

var
  inStr: string;
  n, i, ii, MaxCombinations: Byte;
  m, k, p, TotalWeigth, MinWeigth, MaxWeigth, PacksCount: Integer;
  Goods: array of Integer;
  TempGoods:array of Integer;

function ExtractNextNum(s: string):string;
begin
  Result := Copy(inStr,1,Pos(' ', inStr)-1);
  Delete(inStr,1,Pos(' ', inStr));
end;

begin
  Readln(inStr);
  inStr := inStr + ' ';
  n := StrToInt(ExtractNextNum(inStr));
  m := StrToInt(ExtractNextNum(inStr));
  k := StrToInt(ExtractNextNum(inStr));
  p := StrToInt(ExtractNextNum(inStr));

  Readln(inStr);
  inStr := inStr + ' ';
  SetLength(Goods, n);
  for i:=0 to n-1 do
    begin
      Goods[i]:= StrToInt(ExtractNextNum(inStr));
    end;

  PacksCount:=0;

  MaxCombinations := Trunc(Power(2, n)) - 1; //всего вариантов получить различные наборы товаров

  for i:=3 to MaxCombinations do //
    begin
      SetLength(TempGoods,0);
      //заполняем массив следующей комбинацией товаров
      //используем i как двоичную маску отбора элементов в массиве товаров
      for ii:=0 to n-1 do
        begin
          if ( (i and Trunc(Power(2,ii))) = (Trunc(Power(2,ii))) ) then
           begin
             SetLength(TempGoods,Length(TempGoods)+1);
             TempGoods[Length(TempGoods)-1]:=Goods[ii];
            end;
        end;

      if Length(TempGoods)<2 then Continue;//набор из 1 товара сразу нет

      TotalWeigth := 0;
      MinWeigth:=TempGoods[0];
      MaxWeigth:=TempGoods[0];

      for ii:=0 to Length(TempGoods)-1 do
       begin
         TotalWeigth:=TotalWeigth + TempGoods[ii];
         if MinWeigth > TempGoods[ii] then MinWeigth:= TempGoods[ii];
         if MaxWeigth < TempGoods[ii] then MaxWeigth:= TempGoods[ii];
       end;

      if ((TotalWeigth < m) or (TotalWeigth > k)) then Continue; //условие суммарного веса
      if ((MaxWeigth - MinWeigth) < p) then Continue;  //условие разницы крайних весов

      Inc(PacksCount);//условия подошли - берем как вариант пачки товаров

     end;

  Writeln(inttostr(PacksCount));
 // readln;

end.

var i,n,s1,r,min1,max1,min,max,k,k1:longint;
    a,a1:array[0..100] of integer;
begin

readln(n,min,max,r);
for i:=1 to n do
 read(a1[i]);
for i:=0 to n do
 a[i]:=0;
k:=0;
while a[0]=0 do
 begin
 min1:=19999;
  for i:=1 to n do
   if a[i]=1
    then
     begin
      if min1>a1[i]
       then
        min1:=a1[i];
      if max1<a1[i]
       then
        max1:=a1[i];
      s1:=s1+a1[i];
      k1:=k1+1;
     end;
  if (s1>=min) and (s1<=max) and (k1>1) and ((max1-min1)>=r)
   then
    k:=k+1;
  s1:=0;
  k1:=0;
  max1:=0;
  i:=n;
  while a[i]=1 do
   begin
    a[i]:=0;
    i:=i-1;
   end;
  a[i]:=1;
 end;
writeln(k);

end.

program t2;
var
 n,l,r,x,i,j,t,e,b:longint;
 y:int64;
 a:array[0..15]of longint;
procedure he(c,d,s:int64);
var
 k:integer;
 begin
  if(s>l)and(s<r)then inc(y);
  if s<r then
   for k:=(d-1) downto (c+1) do
    he(c,k,s+a[k]);
 end;
begin
 readln(n,l,r,x);
 for i:=0to(n-1)do
  read(a[i]);
 readln;
 for j:=(n-1)downto 2do
  for i:=0to j-1 do
   begin
    if a[i]>a[i+1] then
     begin
      t:=a[i];
      a[i]:=a[i+1];
      a[i+1]:=t;
     end;
   end;
  {for i:=(n-1)downto 0do
   if a[i]+a[0]<=r then break;
  e:=i;
  for i:=0to(n-1)do
   if a[e]-a[i]<=x then break;
  b:=i-1;}
  for i:=(n-1) downto 1 do
   begin
    for j:=0 to(i-1)do
    if a[i]-a[j]>=x then he(j,i,a[i]+a[j])
   end;
  writeln(y);
end.


Bishwock is a chess figure that consists of three squares resembling an "L-bar". This figure can be rotated by 90, 180 and 270 degrees so it can have four possible states: XX   XX   .X   X.X.   .X   XX   XX Bishwocks don't attack any squares and can even occupy on the adjacent squares as long as they don't occupy the same square. Vasya has a board with $$$2\times n$$$ squares onto which he wants to put some bishwocks. To his dismay, several squares on this board are already occupied by pawns and Vasya can't put bishwocks there. However, pawns also don't attack bishwocks and they can occupy adjacent squares peacefully.Knowing the positions of pawns on the board, help Vasya to determine the maximum amount of bishwocks he can put onto the board so that they wouldn't occupy the same squares and wouldn't occupy squares with pawns.

The input contains two nonempty strings that describe Vasya's board. Those strings contain only symbols "0" (zero) that denote the empty squares and symbols "X" (uppercase English letter) that denote the squares occupied by pawns. Strings are nonempty and are of the same length that does not exceed $$$100$$$.

Output a single integer — the maximum amount of bishwocks that can be placed onto the given board.

var
	i,c:integer;
	p,q:string;
	a:array[1..2,1..100] of boolean;
begin
	readln(p);
	readln(q);
	fillchar(a,sizeof(a),true);
	c:=0;
	for i:=1 to length(p) do
	begin
		if p[i]='X' then a[1,i]:=false;
		if q[i]='X' then a[2,i]:=false;
	end;
	for i:=1 to length(p)-1 do
	begin
		if a[1,i] and a[2,i] and a[1,i+1] then
		begin
			a[1,i]:=false;
			a[2,i]:=false;
			a[1,i+1]:=false;
			inc(c);
		end;
		if a[1,i] and a[2,i] and a[2,i+1] then
		begin
			a[1,i]:=false;
			a[2,i]:=false;
			a[2,i+1]:=false;
			inc(c);
		end;
		if a[1,i] and a[1,i+1] and a[2,i+1] then
		begin
			a[1,i]:=false;
			a[1,i+1]:=false;
			a[2,i+1]:=false;
			inc(c);
		end;
		if a[2,i] and a[1,i+1] and a[2,i+1] then
		begin
			a[2,i]:=false;
			a[1,i+1]:=false;
			a[2,i+1]:=false;
			inc(c);
		end;
	end;
	write(c);
end.

var a:array [1..2] of string;
sum,i:longint;
begin
//assign(input,'bswk.in');reset(input);
//assign(output,'bswk.out');rewrite(Output);
readln(a[1]);
readln(a[2]);
a[1]:='X'+a[1]+'X';a[2]:='X'+a[2]+'X';
for i:=2 to length(a[1])-1 do
  if (a[1,i]='0') and (a[2,i]='0') and ((a[1,i-1]='0') or (a[1,i+1]='0') or (a[2,i-1]='0') or (a[2,i+1]='0')) then
    begin
    a[1,i]:='X';a[2,i]:='X';
    if a[1,i-1]='0' then a[1,i-1]:='X'
    else if a[2,i-1]='0' then a[2,i-1]:='X'
    else if a[1,i+1]='0' then a[1,i+1]:='X'
    else a[2,i+1]:='X';
    inc(sum);
    end;
writeln(sum);
close(input);close(output);
end.

var s1,s2:string;i,s:longint;
begin
//assign(input,'bswk.in');reset(input);
//assign(output,'bswk.out');rewrite(output);
readln(s1);
readln(s2);
for i:=1 to length(s1) do
  if s1[i]+s2[i]='00' then
    begin
    if (i<>1) and (s1[i-1]='0') then
      begin
      s1[i-1]:='X';s1[i]:='X';s2[i]:='X';s:=s+1;
      end
    else if (i<>1) and (s2[i-1]='0') then
      begin
      s2[i-1]:='X';s1[i]:='X';s2[i]:='X';s:=s+1;
      end
    else if (i<>length(s1)) and (s1[i+1]='0') then
      begin
      s1[i+1]:='X';s1[i]:='X';s2[i]:='X';s:=s+1;
      end
    else if (i<>length(s1)) and (s2[i+1]='0') then
      begin
      s2[i+1]:='X';s1[i]:='X';s2[i]:='X';s:=s+1;
      end;
    end;
writeln(s);
close(input);close(output);
end.

var
   c : array[1..2 , 1..100] of char ;
   ch : char ;
   ans , len , i : integer ;
   flag : boolean ;
begin
     len := 0 ;
     flag := true ;
     while flag do
     begin
           read( ch ) ;
           if ( ch <> '0' ) and ( ch <> 'X' ) then flag := false
           else
            begin
                 len := len + 1 ;
                 c[1 , len] := ch ;
            end ;
     end ;
     readln ;
     for i := 1 to len do
         read( c[2 , i] ) ;
     ans := 0 ;
     for i := 2 to len do
     begin
          flag := false ;
          if ( c[1 , i - 1] = '0' ) and ( c[2 , i - 1] = '0' ) then
          begin
               if c[1 , i] = '0' then
               begin
                    flag := true ;
                    c[1 , i - 1] := 'X' ;
                    c[2 , i - 1] := 'X' ;
                    c[1 , i] := 'X' ;
               end
               else
                if c[2 , i] = '0' then
                begin
                     flag := true ;
                     c[1 , i - 1] := 'X' ;
                     c[2 , i - 1] := 'X' ;
                     c[2 , i] := 'X' ;
                end ;
          end ;
          if ( c[1 , i] = '0' ) and ( c[2 , i] = '0' ) and ( flag = false ) then
          begin
               if c[1 , i - 1] = '0' then
               begin
                    flag := true ;
                    c[1 , i - 1] := 'X' ;
                    c[1 , i] := 'X' ;
                    c[2 , i] := 'X' ;
               end
               else
                if c[2 , i - 1] = '0' then
                begin
                     flag := true ;
                     c[2 , i - 1] := 'X' ;
                     c[1 , i] := 'X' ;
                     c[2 , i] := 'X' ;
                end ;
          end ;
          if flag = true then ans := ans + 1 ;
     end ;
     writeln( ans ) ;
end.

var a , b : ansistring ;
    c , d , e , f , n , flag , ans : longint ;
     begin
    //  assign ( input , 'a.in' ) ; reset ( input ) ;
    //  assign ( output , 'a.out' ) ; rewrite ( output ) ;
      readln ( a ) ;
      readln ( b ) ;
      c := length ( a ) ;
      d := 0 ;
      while d < c do
       begin
        e := 1 ; d := d + 1 ;
        while ( a [ d ] = '0' ) and ( b [ d ] = '0' ) do
         begin
          inc ( d ) ;
          inc ( e ) ;
         end ; e := e - 1 ;
        if flag = 1 then if e > 0 then
         begin
          e := e - 1 ;
          ans := ans + 1 ;
         end ;
        ans := ans + e div 3 * 2 ;
        e := e mod 3 ; flag := 0 ;
        if e mod 3 = 0 then
         begin
          if ( a [ d ] = '0' ) or ( b [ d ] = '0' ) then
           flag := 1 ;
         end ;
        if e mod 3 = 1 then
         begin
          if ( a [ d ] = '0' ) or ( b [ d ] = '0' ) then
           ans := ans + 1 ;
         end ;
        if e mod 3 = 2 then
         begin
          ans := ans + 1 ;
          if ( a [ d ] = '0' ) or ( b [ d ] = '0' ) then
           flag := 1 ;
         end ;
       end ;
      write ( ans ) ; //close ( input ) ; close ( output ) ;
     end .

type ta = array[1..2,1..100] of char;
var a:ta;
    i,u,m,k,j:integer;
    s:string;
function recurs(a:ta;u:integer):integer;
var k:integer;
begin
k:=0;
if (a[1,u]='0') then
k:=k+1;
if (a[1,u+1]='0') then
k:=k+1;
if (a[2,u]='0') then
k:=k+1;
if (a[2,u+1]='0') then
k:=k+1;
recurs:=k;
end;
begin
readln(s);
m:=length(s);
for i:=1 to m do
a[1,i]:=s[i];
readln(s);
for i:=1 to m do
a[2,i]:=s[i];
u:=1;
k:=0;
j:=0;
while u<m do
begin
k:=recurs(a,u);
if k=3 then begin a[1,u]:='X';a[1,u+1]:='X';a[2,u]:='X';a[2,u+1]:='X'; j:=j+1; end;
if k=4 then begin a[1,u]:='X';a[1,u+1]:='X';a[2,u]:='X';j:=j+1; end;
u:=u+1;
end;
{for i:=1 to m do write(a[1,i]);
writeln;
for i:=1 to m do write(a[2,i]);}
writeln(j);
end.

          const eps=0.00000001;  besk1=200000008;  nn=200000;
   besk=8000000000000000000;
   label 1,2,3,4;
    type    real=extended;  {string=ansistring;}
    mas=array [-10..nn] of int64;   point=record x,y,z:real;end;
    zap=record p1,p2,p3 :int64;end; zap1=^zap;
    mass=array[0..nn] of longint;mass1=^mass;
    var pos1,pos2,ost,ot,aa,bb,cc,p1,p2,p3,p4,kk,znamzz,kolperiod,znam,tperiod,start,finish,kol1,kol2,lavel,time,x0,modul,pos,p0,t2,t1,jj,w,ii,ogr,q,p,pp,tt,oldtt,qq,qq1,qq2,q1,q2,pmax,imax,t,nm,n,m,s,smin,cen,dl,i1:int64;
   k,step1, step, i,j:longint;
    ppp,prob1,prob2,prob3,pr1new,pr2new,pr3new,pr1,pr2,pr3:zap;
    vv,znak,ll:int64;
    name,d,dnew, voltay,l,r,c,z,day,b,a:array[-200000..1600000] of int64;
    zz:array[0..125000000] of byte;
    gr,pole:array[-10..1002,-10..1005] of char;
    ddd,dd1,dd2,dd3,dd4,dd,ddsum:array[-10..1101,-10..1010] of int64;
   zanx,zany:array[-10..2000000,0..3] of boolean;
    sss1,sss2:string;
    newnabor,stoim,nabor:array[-10..200005] of int64;
     zan,fl:array[-100..1000000,0..3] of boolean;
    ss1,ss2,ss:string;ch,ch1,ch2:char;
    s2,s1:array[-100..200000] of string;
    grr :array [-10..2010,-10..2010] of boolean;
    maxpr:array[0..nn] of string;
    sss:array[-10..nn] of string;
     xx,yy,vel,x1,y1,ott,v0,v1,s0,t0:extended;
     zv:point;
     ugol,rr,yc,xc,y,rot,x,temp,sumtemp,vol,newx,newy:array[-10..400000] of extended;
     sq,sqx,sqy,ottt,aaa,bbb,ccc:extended;
     xxx,yyy,yot:double;
       flag2,flag,flag1:boolean;

      function nod(x,y:int64):int64; var z:int64;
begin   repeat  z:=x mod y;x:=y;y:=z;   until  z=0 ;  nod:=x;end;

     function summ(xx,yy:zap):zap1;
var t1,t2,tt:int64; ott:zap;
 begin
    t1:=(xx.p1*yy.p2+xx.p2*yy.p1) mod modul;
    t2:=(xx.p2*yy.p2) mod modul;
    tt:=nod(t1,t2);
    t1:=t1 div tt mod modul;
    t2:=t2 div tt mod modul;
    ott.p1:=t1; ott.p2:=t2;

   summ:=@ott;
 end;

     function prod(xx,yy:zap):zap1;
var t1,t2,tt:int64; ott:zap;
 begin
    t1:=(xx.p1*yy.p1) mod modul;
    t2:=(xx.p2*yy.p2) mod modul;
    tt:=nod(t1,t2);
    t1:=(t1 div tt) mod modul;
    t2:=(t2 div tt) mod modul;
    ott.p1:=t1; ott.p2:=t2;

   prod:=@ott;
 end;

    function al(x,y:real):real; var t0,t1,p,s0,s1:real;
 begin
     if (x>0)and(y>=0) then p:=arctan(y/x);
     if x<0 then p:=pi+arctan(y/x);
     if(x>0)and(y<0) then p:=2*pi+arctan(y/x);
     if x=0 then if (y>=0) then p:=pi/2 else p:=3*pi/2;
     al:=p{/pi*180};
 end;
  function min(x,y:extended):extended;begin min:=x;if y<x then min:=y; end;
  function max(x,y:int64):int64;begin max:=x;if y>x then max:=y; end;

function degg(a,k:int64):int64; var p:int64;
begin
 if k<=0 then degg:=1 else if odd(k) then degg:=degg(a,k-1)*a mod modul else
   begin  p:=degg(a,k shr 1); degg:=p*p mod modul;   end;

end;

function prost(tt:longint):boolean;
var aa:extended; i,p,t:longint;  fl:boolean;
 begin
   fl:=true;
   aa:=tt;
   aa:=sqrt(aa);
   t:=round(aa);
   for i:=2 to t do if tt mod i=0 then fl:=false;

   prost:=fl;
 end;

function arcsin(pp:extended):extended;
var tt:extended;
begin
   if (abs(pp)<=1+eps)and (abs(pp)>=1-eps)
   then if pp>0 then arcsin:=pi/2 else arcsin:=-pi/2;
   tt:=1-pp*pp;
   if abs(tt)>=0 then
     begin
        arcsin:=arctan(pp/sqrt(tt));

     end;

end;

function sum(koef:extended):extended;
var i,j:longint; ot,pp:extended; flag:boolean;
begin
   flag:=true;    pp:=1e+20; ot:=0;
   for i:=1 to n do pp:=min(pp,y[i]-koef*x[i]);
   for i:=1 to n do ot:=ot+y[i]-(koef*x[i]+pp);

 if flag then sum:=ot else ot:=1e+20;
end;

begin

  {  assign (input,'input.txt');reset(input);
      assign (output,'output.txt'); rewrite(output);
   }

    for i:=1 to 2 do readln(sss[i]);
    n:=length(sss[1]);
    for i:=1 to n do if sss[1][i]='X' then zan[i,1]:=true;
    for i:=1 to n do if sss[2][i]='X' then zan[i,2]:=true;
    zan[n+1,1]:=true;
     zan[n+1,2]:=true;

    for i:=1 to n do
     begin
        if not zan[i,1] and not zan[i+1,1] and not zan[i,2] then
          begin zan[i,1]:=true; zan[i+1,1]:=true; zan[i,2]:=true; inc(ot);  goto 2; end;

        if not zan[i,1] and not zan[i+1,2] and not zan[i,2] then
          begin zan[i,1]:=true; zan[i+1,2]:=true; zan[i,2]:=true; inc(ot);  goto 2; end;

         if not zan[i,1] and not zan[i+1,2] and not zan[i+1,1] then
          begin zan[i,1]:=true; zan[i+1,2]:=true; zan[i+1,1]:=true; inc(ot);  goto 2; end;

          if not zan[i,2] and not zan[i+1,2] and not zan[i+1,1] then
          begin zan[i,2]:=true; zan[i+1,2]:=true; zan[i+1,1]:=true; inc(ot);  goto 2; end;

  2:
   {  writeln('i= ',i);
     for k:=1 to 2 do begin  for j:=1 to n do if zan[j,k] then write('X') else write('.'); writeln; end;
    }
     end;

                          writeln(ot);

   1:          close(output);
end.

var i,j,fa,o:longint;
a:array[0..2]of string;
begin
//assign(input,'bswk.in');reset(input);
//assign(output,'bswk.out');rewrite(output);
readln(a[1]);
readln(a[2]);
fa:=length(a[2]);
for J:=1 to fa do
  for I:=1 to 2 do
    if a[i,j]='0'then
      begin
      if(j>1)and(i=1)then
        if(a[i,j-1]='0')and(a[i+1,j]='0')then
          begin
          inc(o);
          a[i,j]:='X';
          a[i,j-1]:='X';
          a[i+1,j]:='X';
          end;
      if a[i,j]<>'0'then continue;
      if(j>1)and(i>1)then
        if(a[i,j-1]='0')and(a[i-1,j]='0')then
          begin
          inc(o);
          a[i,j]:='X';
          a[i,j-1]:='X';
          a[i-1,j]:='X';
          end;
      if a[i,j]<>'0'then continue;
      if(j+1<=fa)and(i=1)then
        if(a[i,j+1]='0')and(a[i+1,j]='0')then
          begin
          inc(o);
          a[i,j]:='X';
          a[i,j+1]:='X';
          a[i+1,j]:='X';
          end;
      if a[i,j]<>'0'then continue;
      if(j+1<=fa)and(i=2)then
        if(a[i,j+1]='0')and(a[i-1,j]='0')then
          begin
          inc(o);
          a[i,j]:='X';
          a[i-1,j]:='X';
          a[i,j+1]:='X';
          end;
      end;
write(o);
close(input);close(output);
end.

var a , b : ansistring ;
    c , d , e , f , n , flag , ans : longint ;
     begin
   //   assign ( input , 'a.in' ) ; reset ( input ) ;
   //   assign ( output , 'a.out' ) ; rewrite ( output ) ;
      readln ( a ) ;
      readln ( b ) ;
      c := length ( a ) ;
      d := 0 ;
      while d < c do
       begin
        e := 1 ; d := d + 1 ;
        while ( a [ d ] = '0' ) and ( b [ d ] = '0' ) do
         begin
          inc ( d ) ;
          inc ( e ) ;
         end ; e := e - 1 ;
        if flag = 1 then if e > 0 then
         begin
          e := e - 1 ;
          ans := ans + 1 ;
         end ;
        ans := ans + e div 3 ;
        e := e mod 3 ; flag := 0 ;
        if e mod 3 = 0 then
         begin
          if ( a [ d ] = '0' ) or ( b [ d ] = '0' ) then
           flag := 1 ;
         end ;
        if e mod 3 = 1 then
         begin
          if ( a [ d ] = '0' ) or ( b [ d ] = '0' ) then
           ans := ans + 1 ;
         end ;
        if e mod 3 = 2 then
         begin
          ans := ans + 1 ;
          if ( a [ d ] = '0' ) or ( b [ d ] = '0' ) then
           flag := 1 ;
         end ;
       end ;
      write ( ans ) ; close ( input ) ; close ( output ) ;
     end .

type ta = array[1..2,1..100] of char;
var a:ta;
    i,u,m,k:integer;
    s:string;
function recurs(a:ta;u:integer):integer;
var k:integer;
begin
k:=0;
if (a[1,u]='0') then
k:=k+1;
if (a[1,u+1]='0') then
k:=k+1;
if (a[2,u]='0') then
k:=k+1;
if (a[2,u+1]='0') then
k:=k+1;
if k>2 then recurs:=1;
end;
begin
readln(s);
m:=length(s);
for i:=1 to m do
a[1,i]:=s[i];
readln(s);
for i:=1 to m do
a[2,i]:=s[i];
u:=1;
k:=0;
while u<m do
begin
k:=k+recurs(a,u);
u:=u+1;
end;
writeln(k);
end.

type ta = array[1..2,1..100] of char;
var a:ta;
    i,u,m,k:integer;
    s:string;
function recurs(a:ta;u:integer):integer;
var k:integer;
begin
k:=0;
if (a[1,u]='0') then
k:=k+1;
if (a[1,u+1]='0') then
k:=k+1;
if (a[2,u]='0') then
k:=k+1;
if (a[2,u+1]='0') then
k:=k+1;
if k=3 then
begin
recurs:=1;
a[1,u]:='X';a[1,u+1]:='X';a[2,u]:='X';a[2,u+1]:='X';
end;
if k=4 then
begin
recurs:=1;
a[1,u]:='X';a[1,u+1]:='X';a[2,u]:='X';
end;
end;
begin
readln(s);
m:=length(s);
for i:=1 to m do
a[1,i]:=s[i];
readln(s);
for i:=1 to m do
a[2,i]:=s[i];
u:=1;
k:=0;
while u<m do
begin
k:=k+recurs(a,u);
u:=u+1;
end;
writeln(k);
end.

type ta = array[1..2,1..100] of char;
var a:ta;
    i,u,m,k,j:integer;
    s:string;
function recurs(a:ta;u:integer):integer;
var k:integer;
begin
k:=0;
if (a[1,u]='0') then
k:=k+1;
if (a[1,u+1]='0') then
k:=k+1;
if (a[2,u]='0') then
k:=k+1;
if (a[2,u+1]='0') then
k:=k+1;
if k>2 then
begin
recurs:=k;
end;
end;
begin
readln(s);
m:=length(s);
for i:=1 to m do
a[1,i]:=s[i];
readln(s);
for i:=1 to m do
a[2,i]:=s[i];
u:=1;
k:=0;
j:=0;
while u<m do
begin
k:=k+recurs(a,u);
if k=3 then begin a[1,u]:='X';a[1,u+1]:='X';a[2,u]:='X';a[2,u+1]:='X'; j:=j+1; end;
if k=4 then begin a[1,u]:='X';a[1,u+1]:='X';a[2,u]:='X';j:=j+1; end;
u:=u+1;
end;
writeln(j);
end.