Program cf99e;
Var ss:ansistring;
    total:array['a'..'z'] of longint;
    place:array['a'..'z',0..100000] of longint;
    cc,s:array[1..100000] of char;
    cl,cr:array[1..100000] of longint;
    a,c:array[1..100000] of longint;
    ans:int64;
    d,i,j,k,left,right,n,m,cur,std:longint;
begin
  readln(ss);
  n:=length(ss);
  for i:=1 to n do
    begin
      s[i]:=ss[i];
      inc(total[s[i]]);
      c[i]:=total[s[i]];
      place[s[i],total[s[i]]]:=i;
    end;
  readln(m,left,right);
  for i:=1 to m do
    readln(cc[i],cl[i],cr[i]);
  cur:=0;
  for i:=1 to m do if cl[i]=0 then inc(std);
  for d:=1 to n do
    begin
      a[d]:=std;
      if (left<=a[d]) and (a[d]<=right) then inc(cur);
      for k:=1 to m do
        if cc[k]=s[d] then
          begin
            if c[d]-cr[k]-1>=0 then
              begin
                for i:=place[s[d],c[d]-cr[k]-1]+1 to place[s[d],c[d]-cr[k]] do
                  begin
                    dec(a[i]);
                    if a[i]=left-1 then cur:=cur-1;
                    if a[i]=right then cur:=cur+1;
                  end;
              end;
            if cl[k]<>0 then
            if c[d]-cl[k]>=0 then
              begin
                for i:=place[s[d],c[d]-cl[k]]+1 to place[s[d],c[d]-cl[k]+1] do
                  begin
                    inc(a[i]);
                    if a[i]=right+1 then cur:=cur-1;
                    if a[i]=left then cur:=cur+1;
                  end;
              end;
          end;
      ans:=ans+cur;
    end;
  writeln(ans);
end.

{$APPTYPE CONSOLE}
{$R-,Q-,O+,S-}
var
  n, m, i, j, q, x, y, lf, rg : longint;
  ans, cur : int64;
  c : char;
  s : string;
  op, opa : array [-1..1] of longint;
  a : array [1..1000010] of longint;
  ch : array [1..510] of char;
  u, v : array [1..510] of longint;
  p : array ['a'..'z', 0..100010] of longint;
  r : array ['a'..'z'] of longint;
procedure upd(k, d : longint);
begin
  if a[k] = x - 1 + op[d] then
    inc(cur, opa[d]);
  if a[k] = y + op[d] then
    dec(cur, opa[d]);
  inc(a[k], d);
end;
begin
 // reset(input, 'input.txt');
 // Rewrite(output, 'output.txt');
  Readln(s);
  ans := 0;
  lf := 0;
  op[1] := 0;
  op[-1] := 1;
  opa[1] := 1;
  opa[-1] := -1;
  n := Length(s);
  readln(m, x, y);
  for i := 1 to m do
    readln(ch[i], u[i], v[i]);
  for q := 1 to n do
    begin
      c := s[q];
      inc(r[c]);
      p[c, r[c]] := q;
      if x = 0 then
        inc(cur);
      for i := 1 to m do
        if ch[i] = c then
          begin
            if r[c] > v[i] then
              begin
                lf := p[c, r[c] - v[i] - 1] + 1;
                rg := p[c, r[c] - v[i]];
                for j := lf to rg do
                  upd(j, -1);
              end;
            rg := lf - 1;
            if u[i] = 0 then
              begin
                lf := q;
                rg := q;
              end
            else
              if r[c] >= u[i] then
                begin
                  lf := p[c, r[c] - u[i]] + 1;
                  rg := p[c, r[c] - u[i] + 1];
                end;
            for j := lf to rg do
              upd(j, 1);
          end
        else
          if u[i] = 0 then
            upd(q, 1);
      ans := ans + cur;
    end;
  writeln(ans);
end.

program cf138e;
var
  ct:array[0..100000]of longint;
  l,r,mk,lf,rf:array[0..1000]of longint;
  ss:array[0..100000]of char;
  s:array[0..100000,0..26]of longint;
  n,m,ll,rr,i,j,h,ctt:longint;
  ans:int64;
procedure init;
var i,j,h:longint;
begin
  n:=0;
  while not(eoln) do begin
    inc(n);
    read(ss[n]);
  end;      readln;

  for i:=0 to 26 do s[0,i]:=0;
  for i:=1 to n do begin
    for j:=0 to 26 do s[i,j]:=s[i-1,j];
    inc(s[i,ord(ss[i])-ord('a')]);
  end;

  readln(m,ll,rr);
  for i:=1 to m do begin
    read(ss[1]);
    mk[i]:=ord(ss[1])-ord('a');
    readln(l[i],r[i]);
  end;
end;

procedure main;
var
  i,j,h:longint;
  kind:boolean;
begin
  ans:=0;
  ctt:=0;
  for i:=1 to m do begin
    rf[i]:=0;
    lf[i]:=1;
  end;

 { for i:=1 to m do lf[i]:=1;
  fillchar(rf,sizeof(rf),0);     }
  for i:=1 to n do ct[i]:=0;
  for h:=1 to n do begin
    if ll=0 then
      inc(ctt,1);
    for i:=1 to m do begin
      while (rf[i]<h)and(s[h,mk[i]]-s[rf[i],mk[i]]>=l[i]) do begin
        if (ct[rf[i]+1]<=rr)and(ll<=ct[rf[i]+1]) then kind:=true
        else kind:=false;
        inc(ct[rf[i]+1]);
        if (not(kind))and(ct[rf[i]+1]<=rr)and(ct[rf[i]+1]>=ll) then
          inc(ctt);
        if (kind)and(not((ct[rf[i]+1]<=rr)and(ct[rf[i]+1]>=ll))) then
          dec(ctt);
        inc(rf[i]);
      end;

      while (lf[i]<=h)and(s[h,mk[i]]-s[lf[i]-1,mk[i]]>r[i]) do begin
        if (ct[lf[i]]<=rr)and(ll<=ct[lf[i]]) then kind:=true
        else kind:=false;
        dec(ct[lf[i]]);
        if (not(kind))and(ct[lf[i]]<=rr)and(ct[lf[i]]>=ll) then
          inc(ctt);
        if (kind)and(not((ct[lf[i]]<=rr)and(ct[lf[i]]>=ll))) then
          dec(ctt);
        inc(lf[i]);
      end;

    end;

    ans:=ans+ctt;
  end;
  writeln(ans);
end;

begin
  init;
  main;
end.

Program Helish_Constraints;
const maxn=100000;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..maxn]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Modify(k,d:longint);
begin
  if d=1 then
    begin
      if a[k]=x-1 then inc(tot);
      if a[k]=y then dec(tot);
    end
  else
    begin
      if a[k]=x then dec(tot);
      if a[k]=y+1 then inc(tot);
    end;
  a[k]:=a[k]+d;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];inc(r[c]);
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        if r[c]>v[i] then
          begin
            lt:=p[c,r[c]-v[i]-1]+1;
            rt:=p[c,r[c]-v[i]];
            for j:=lt to rt do Modify(j,-1);
          end;

        if (u[i]=0) then
          begin
            lt:=z;rt:=z;
          end
        else
          if r[c]>=u[i] then
            begin
              lt:=p[c,r[c]-u[i]]+1;
              rt:=p[c,r[c]-u[i]+1];
            end
        else rt:=lt-1;
        for j:=lt to rt do Modify(j,1);
      end
    else
      if u[i]=0 then Modify(z,1);
  ans:=ans+tot;
end;
//==============================================================
begin
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

Program Helish_Constraints;
const maxn=100000;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..maxn]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Modify(k,d:longint);
begin
  if d=1 then
    begin
      if a[k]=x-1 then inc(tot);
      if a[k]=y then dec(tot);
    end
  else
    begin
      if a[k]=x then dec(tot);
      if a[k]=y+1 then inc(tot);
    end;
  a[k]:=a[k]+d;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];inc(r[c]);
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        if r[c]>v[i] then
          begin
            lt:=p[c,r[c]-v[i]-1]+1;
            rt:=p[c,r[c]-v[i]];
            for j:=lt to rt do Modify(j,-1);
          end;

        if (u[i]=0) then
          begin
            lt:=z;rt:=z;
          end
        else
          if r[c]>=u[i] then
            begin
              lt:=p[c,r[c]-u[i]]+1;
              rt:=p[c,r[c]-u[i]+1];
            end
        else rt:=lt-1;
        for j:=lt to rt do Modify(j,1);
      end
    else
      if u[i]=0 then Modify(z,1);
  ans:=ans+tot;
end;
//==============================================================
begin
//
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q,tmp:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to Q do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				tmp:=count;
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin tmp:=count;
				if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

Program Helish_Constraints;
const maxn=100000;
      q=511;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..q]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];
  r[c]:=(r[c]+1) and q;
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        lt:=p[c,(r[c]-v[i]-1)and q]+1;
        rt:=p[c,(r[c]-v[i])and q];
        for j:=lt to rt do
          begin
            if a[j]=x then dec(tot);
            if a[j]=y+1 then inc(tot);
            dec(a[j]);
          end;
        if (u[i]=0)and(v[i]>0) then
          begin
            lt:=z;rt:=z;
          end
        else
          begin
            lt:=p[c,(r[c]-u[i])and q]+1;
            rt:=p[c,(r[c]-u[i]+1)and q];
          end;
        for j:=lt to rt do
          begin
            if a[j]=x-1 then inc(tot);
            if a[j]=y then dec(tot);
            inc(a[j]);
          end;
      end
    else
      if u[i]=0 then
        begin
          if a[z]=x-1 then inc(tot);
          if a[z]=y then dec(tot);
          inc(a[z]);
        end;
  ans:=ans+tot;
end;
//==============================================================
begin
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

Program Helish_Constraints;
const maxn=100000;
      q=511;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..q]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];
  r[c]:=(r[c]+1) and q;
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        if u[i]=0 then
          begin
            lt:=p[c,(r[c]-v[i]-2)and q]+1;
            rt:=p[c,(r[c]-v[i]-1)and q];
          end
        else
          begin
            lt:=p[c,(r[c]-v[i]-1)and q]+1;
            rt:=p[c,(r[c]-v[i])and q];
          end;
        for j:=lt to rt do
          begin
            if a[j]=x then dec(tot);
            if a[j]=y+1 then inc(tot);
            dec(a[j]);
          end;

        if (u[i]=0)and(v[i]>0) then
          begin
            lt:=z;rt:=z;
          end
        else
          begin
            lt:=p[c,(r[c]-u[i])and q]+1;
            rt:=p[c,(r[c]-u[i]+1)and q];
          end;
        for j:=lt to rt do
          begin
            if a[j]=x-1 then inc(tot);
            if a[j]=y then dec(tot);
            inc(a[j]);
          end;
      end
    else
      if u[i]=0 then
        begin
          if a[z]=x-1 then inc(tot);
          if a[z]=y then dec(tot);
          inc(a[z]);
        end;
  ans:=ans+tot;
end;
//==============================================================
begin
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

Program Helish_Constraints;
const maxn=100000;
      q=511;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..q]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];
  r[c]:=(r[c]+1) and q;
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        if u[i]=0 then
          begin
            lt:=p[c,(r[c]-v[i]-2)and q]+1;
            if v[i]=0 then rt:=z
                      else rt:=p[c,(r[c]-v[i]-1)and q];
          end
        else
          begin
            lt:=p[c,(r[c]-v[i]-1)and q]+1;
            rt:=p[c,(r[c]-v[i])and q];
          end;

        for j:=lt to rt do
          begin
            if a[j]=x then dec(tot);
            if a[j]=y+1 then inc(tot);
            dec(a[j]);
          end;

        if (u[i]=0)and(v[i]>0) then
          begin
            lt:=z;rt:=z;
          end
        else
          begin
            lt:=p[c,(r[c]-u[i])and q]+1;
            rt:=p[c,(r[c]-u[i]+1)and q];
          end;
        for j:=lt to rt do
          begin
            if a[j]=x-1 then inc(tot);
            if a[j]=y then dec(tot);
            inc(a[j]);
          end;
      end
    else
      if u[i]=0 then
        begin
          if a[z]=x-1 then inc(tot);
          if a[z]=y then dec(tot);
          inc(a[z]);
        end;
  ans:=ans+tot;
end;
//==============================================================
begin
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

Program Helish_Constraints;
const maxn=100000;
      q=511;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..q]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Modify(k,d:longint);
begin
  if d=1 then
    begin
      if a[k]=x-1 then inc(tot);
      if a[k]=y then dec(tot);
    end
  else
    begin
      if a[k]=x then dec(tot);
      if a[k]=y+1 then inc(tot);
    end;
  a[k]:=a[k]+d;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];
  r[c]:=(r[c]+1) and q;
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        if p[c,(r[c]-v[i])and q]>0 then
          begin
            if u[i]=0 then
              begin
                lt:=p[c,(r[c]-v[i]-2)and q]+1;
                if v[i]=0 then rt:=z
                          else rt:=p[c,(r[c]-v[i]-1)and q];
              end
            else
              begin
                lt:=p[c,(r[c]-v[i]-1)and q]+1;
                rt:=p[c,(r[c]-v[i])and q];
              end;
            for j:=lt to rt do Modify(j,-1);
          end;

        if (u[i]=0)and(v[i]>0) then
          begin
            lt:=z;rt:=z;
          end
        else
          begin
            lt:=p[c,(r[c]-u[i])and q]+1;
            rt:=p[c,(r[c]-u[i]+1)and q];
          end;
        for j:=lt to rt do Modify(j,1);
      end
    else
      if u[i]=0 then Modify(z,1);
  ans:=ans+tot;
end;
//==============================================================
begin
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

Program Helish_Constraints;
const maxn=100000;
      q=511;
var n,m,i,j,z,x,y,tot,lt,rt:longint;
    ans:int64;
    c:char;
    s:array[1..maxn]of char;
    a:array[1..maxn]of longint;
    ch:array[1..500]of char;
    u,v:array[1..500]of longint;
    p:array['a'..'z',0..q]of longint;
    r:array['a'..'z']of longint;
//==============================================================
procedure Init;
begin
  repeat
    inc(n);
    read(s[n]);
  until eoln;
  readln(m,x,y);
  for i:=1 to m do
    begin
      read(ch[i]);
      readln(u[i],v[i]);
    end;
end;
//==============================================================
procedure Modify(k,d:longint);
begin
  if d=1 then
    begin
      if a[k]=x-1 then inc(tot);
      if a[k]=y then dec(tot);
    end
  else
    begin
      if a[k]=x then dec(tot);
      if a[k]=y+1 then inc(tot);
    end;
  a[k]:=a[k]+d;
end;
//==============================================================
procedure Work;
begin
  c:=s[z];
  r[c]:=(r[c]+1) and q;
  p[c,r[c]]:=z;
  if x=0 then inc(tot);
  for i:=1 to m do
    if ch[i]=c then
      begin
        if p[c,(r[c]-v[i])and q]>0 then
          begin
            lt:=p[c,(r[c]-v[i]-1)and q]+1;
            rt:=p[c,(r[c]-v[i])and q];
            for j:=lt to rt do Modify(j,-1);
          end;

        if (u[i]=0) then
          begin
            lt:=z;rt:=z;
          end
        else
          begin
            lt:=p[c,(r[c]-u[i])and q]+1;
            rt:=p[c,(r[c]-u[i]+1)and q];
          end;
        for j:=lt to rt do Modify(j,1);
      end
    else
      if u[i]=0 then Modify(z,1);
  ans:=ans+tot;
end;
//==============================================================
begin
  Init;
  for z:=1 to n do Work;
  writeln(ans);
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q,tmp:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				tmp:=count;
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if tmp<>count then writeln('NOO');
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin tmp:=count;
				if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if tmp<>count then writeln('NOpO',' ',j,' ',letter[j],' ',l[j],' ',r[j],' ',left[j],' ',meet[left[j]]);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            if (s[1]='l')and(s[2]='w')and(s[3]='x') then if count<>i then writeln(i,' ',count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	if (s[1]='l')and(s[2]='w')and(s[3]='x') then writeln(Q,' ',downlim,' ',uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            //writeln(count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=right[j])and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            //writeln(count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do readln(letter[i],l[i],r[i]);
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=0;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[i]) do
			begin inc(right[j]);
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=right[j])and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[i]) do
			begin if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		if (downlim=0)and(meet[i]=0) then inc(count);
            writeln(count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do readln(letter[i],l[i],r[i]);
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=right[j])and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            //writeln(count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            if (s[1]='l')and(s[2]='w')and(s[3]='x') then if count<>i then writeln(i,' ',count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q,tmp:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				tmp:=count;
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if tmp<>count then writeln('NOO');
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin tmp:=count;
				if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if tmp<>count then writeln('NOpO');
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            if (s[1]='l')and(s[2]='w')and(s[3]='x') then if count<>i then writeln(i,' ',count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if meet[right[j]]=500 then writeln('No');
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin if (s[1]='l')and(s[2]='w')and(s[3]='x') then if meet[right[j]]=0 then writeln('Nooo');
				if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            if (s[1]='l')and(s[2]='w')and(s[3]='x') then if count<>i then writeln(i,' ',count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            //writeln(count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

var
s:array[0..100010] of char;
sum:array[0..100010,'a'..'z'] of longint;
left,right,meet:array[0..100010] of longint;
letter:array[0..510] of char;
l,r:array[0..510] of longint;
uplim,downlim:longint;

function check(x:longint):boolean; begin exit((downlim<=x)and(x<=uplim)); end;

procedure lemon;
var n,i,j,count,Q,tmp:longint;
    ans:int64;
    ch:char;
begin n:=0;
	while not seekeoln(input) do
	begin read(ch);
		inc(n); s[n]:=ch;
	end;
	for ch:='a' to 'z' do sum[0,ch]:=0;
	for i:=1 to n do
	begin sum[i]:=sum[i-1];
		inc(sum[i,s[i]]);
	end;
	readln(Q,downlim,uplim);
	for i:=1 to Q do
	begin readln(letter[i],l[i],r[i]);
		if l[i]>r[i] then writeln('no');
	end;
	fillchar(meet,sizeof(meet),0);
	for i:=1 to n do begin left[i]:=1;  right[i]:=0; end;
	ans:=0; count:=0;
	for i:=1 to n do
      begin for j:=1 to Q do
		begin //[left[j]~right[j],i] is available interval
			if sum[i,letter[j]]-sum[left[j]-1,letter[j]]<l[j] then continue;
			while (right[j]<i)and(sum[i,letter[j]]-sum[right[j],letter[j]]>=l[j]) do
			begin inc(right[j]);
				tmp:=count;
				if check(meet[right[j]]) then dec(count);
				inc(meet[right[j]]);
				if check(meet[right[j]]) then inc(count);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if tmp<>count then writeln('NOO');
			end;
			while (left[j]<=i)and(sum[i,letter[j]]-sum[left[j]-1,letter[j]]>r[j]) do
			begin tmp:=count;
				if check(meet[left[j]]) then dec(count);
				dec(meet[left[j]]);
				if check(meet[left[j]]) then inc(count);
				if (s[1]='l')and(s[2]='w')and(s[3]='x') then if tmp<>count then writeln('NOpO',' ',meet[left[j]]);
				inc(left[j]);
			end;
		end;
		//for j:=1 to Q do writeln(left[j],' ',right[j]);
		if downlim=0 then inc(count);
            if (s[1]='l')and(s[2]='w')and(s[3]='x') then if count<>i then writeln(i,' ',count);
		inc(ans,count);
	end;
	writeln(ans);
end;

begin
{$ifndef ONLINE_JUDGE}
	assign(input,'138E.in');
	reset(input);
{$endif}
lemon;
end.

Program cf99e;
Var ss:ansistring;
    total:array['a'..'z'] of longint;
    place:array['a'..'z',0..100000] of longint;
    cc,s:array[1..100000] of char;
    cl,cr:array[1..100000] of longint;
    a,c:array[1..100000] of longint;
    ans:int64;
    d,i,j,k,left,right,n,m,cur,std:longint;
begin
  readln(ss);
  n:=length(ss);
  for i:=1 to n do
    begin
      s[i]:=ss[i];
      inc(total[s[i]]);
      c[i]:=total[s[i]];
      place[s[i],total[s[i]]]:=i;
    end;
  readln(m,left,right);
  for i:=1 to m do
    readln(cc[i],cl[i],cr[i]);
  cur:=0;
  for i:=1 to m do if cl[i]=0 then inc(std);
  for d:=1 to n do
    begin
      a[d]:=std;
      if (left<=a[d]) and (a[d]<=right) then inc(cur);
      for k:=1 to m do
        if cc[k]=s[d] then
          begin
            if c[d]-cr[k]-1>=0 then
              begin
                for i:=place[s[d],c[d]-cr[k]-1]+1 to place[s[d],c[d]-cr[k]] do
                  begin
                    dec(a[i]);
                    if a[i]=left-1 then cur:=cur-1;
                    if a[i]=right then cur:=cur+1;
                  end;
              end;
            if c[d]-cl[k]>=0 then
              begin
                for i:=place[s[d],c[d]-cl[k]]+1 to place[s[d],c[d]-cl[k]+1] do
                  begin
                    inc(a[i]);
                    if a[i]=right+1 then cur:=cur-1;
                    if a[i]=left then cur:=cur+1;
                  end;
              end;
          end;
      ans:=ans+cur;
    end;
  writeln(ans);
end.

Program cf99e;
Var s:ansistring;
    total:array['a'..'z'] of longint;
    place:array['a'..'z',0..100000] of longint;
    cc:array[1..100000] of char;
    cl,cr:array[1..100000] of longint;
    a,c:array[1..100000] of longint;
    ans:int64;
    d,i,j,k,left,right,n,m,cur:longint;
begin
  readln(s);
  n:=length(s);
  for i:=1 to n do
    begin
      inc(total[s[i]]);
      c[i]:=total[s[i]];
      place[s[i],total[s[i]]]:=i;
    end;
  readln(m,left,right);
  for i:=1 to m do
    readln(cc[i],cl[i],cr[i]);
  cur:=0;
  for d:=1 to n do
    begin
      if left=0 then inc(cur);
      for k:=1 to m do
        if cc[k]=s[d] then
          begin
            if c[d]-cr[k]-1>=0 then
              begin
                for i:=place[s[d],c[d]-cr[k]-1]+1 to place[s[d],c[d]-cr[k]] do
                  begin
                    dec(a[i]);
                    if a[i]=left-1 then cur:=cur-1;
                    if a[i]=right then cur:=cur+1;
                  end;
              end;
            if c[d]-cl[k]>=0 then
              begin
                for i:=place[s[d],c[d]-cl[k]]+1 to place[s[d],c[d]-cl[k]+1] do
                  begin
                    inc(a[i]);
                    if a[i]=right+1 then cur:=cur-1;
                    if a[i]=left then cur:=cur+1;
                  end;
              end;
          end;
      ans:=ans+cur;
    end;
  writeln(ans);
end.


{$R+,S+,Q+,I+,O-}
{R-,S-,Q-,I-,O+}
var
  sum,j,tmp,n,a,b,m,i,sx,sy: longint;
  can: array [0..41111] of boolean;
  x,y,pred,last,xm,ym,ca,cb: array [0..41111] of longint;

procedure Sort(l,r:longint);
var
  i,j,pp,xx,yy,tmp: longint;
begin
  i:=l; j:=r;
  pp:=l+random(r-l+1);
  xx:=x[pp]; yy:=y[pp];
  repeat
    while x[i]*yy > xx*y[i] do inc(i);
    while x[j]*yy < xx*y[j] do dec(j);
    if i <= j then
    begin
      tmp:=x[i]; x[i]:=x[j]; x[j]:=tmp;
      tmp:=y[i]; y[i]:=y[j]; y[j]:=tmp;
      inc(i); dec(j);
    end;
  until i > j;
  if l < j then Sort(l,j);
  if i < r then Sort(i,r);
end;

begin
  randseed:=8753;
//  assign(input,'in'); reset(input);
//  assign(output,'out'); rewrite(output);
  read(n);
  if n = 3 then
  begin
    writeln('YES');
    writeln('0 0');
    writeln('1 0');
    writeln('0 2');
    halt;
  end;
  fillchar(can,sizeof(can),False);
  for a:=0 to 200 do
    for b:=0 to 200 do
      if a*a+b*b <= 40000 then
      begin
        can[a*a+b*b]:=True;
        ca[a*a+b*b]:=a;
        cb[a*a+b*b]:=b;
      end;
  m:=0;
  for i:=1 to 40000 do
    if can[i] then
    begin
      inc(m);
      xm[m]:=ca[i];
      ym[m]:=cb[i];
      if m = n+1 then break;
    end;
  sx:=0; sy:=0;
  for i:=1 to n do
  begin
    inc(sx,xm[i]);
    inc(sy,ym[i]);
  end;
  if (sx+sy) and 1 = 1 then
  begin
    inc(sx,xm[n+1]);
    inc(sy,ym[n+1]);
    for i:=1 to n do
      if ((sx-xm[i])+(sy-ym[i])) and 1 = 0 then
      begin
        dec(sx,xm[i]);
//        dec(sy,ym[i]);
        xm[i]:=xm[n+1];
        ym[i]:=ym[n+1];
        break;
      end;
  end;
  if sx and 1 = 1 then
    for i:=n downto 1 do
      if (xm[i]+ym[i]) and 1 = 1 then
      begin
        tmp:=xm[i];
        xm[i]:=ym[i];
        ym[i]:=tmp;
        break;
      end;
  fillchar(last,sizeof(last),0);
  for i:=1 to n do
  begin
    pred[i]:=last[xm[i]];
    last[xm[i]]:=i;
  end;
  sum:=0;
  for a:=200 downto 0 do
  begin
    j:=last[a];
    while j > 0 do
    begin
      if sum > 0 then xm[j]:=-xm[j];
      inc(sum,xm[j]);
      j:=pred[j];
    end;
  end;
  if sum <> 0 then while true do;
  fillchar(last,sizeof(last),0);
  for i:=1 to n do
  begin
    pred[i]:=last[ym[i]];
    last[ym[i]]:=i;
  end;
  sum:=0;
  for a:=200 downto 0 do
  begin
    j:=last[a];
    while j > 0 do
    begin
      if sum > 0 then ym[j]:=-ym[j];
      inc(sum,ym[j]);
      j:=pred[j];
    end;
  end;
  if sum <> 0 then while true do;
  writeln('YES');
  m:=0;
  for i:=1 to n do
    if (ym[i] > 0) or (ym[i] = 0) and (xm[i] > 0) then
    begin
      inc(m);
      x[m]:=xm[i];
      y[m]:=ym[i];
    end;
  if m > 0 then Sort(1,m);
  sx:=0; sy:=0;
  for i:=1 to m do
  begin
    writeln(sx,' ',sy);
    sx:=sx+x[i];
    sy:=sy+y[i];
  end;
  m:=0;
  for i:=1 to n do
    if not ((ym[i] > 0) or (ym[i] = 0) and (xm[i] > 0)) then
    begin
      inc(m);
      x[m]:=xm[i];
      y[m]:=-ym[i];
    end;
  if m > 0 then Sort(1,m);
  for i:=m downto 1 do
  begin
    writeln(sx,' ',sy);
    sx:=sx+x[i];
    sy:=sy-y[i];
  end;
  close(input);
  close(output);
end.

{$R+,S+,Q+,I+,O-}
{R-,S-,Q-,I-,O+}
var
  sum,j,tmp,n,a,b,m,i,sx,sy: longint;
  can: array [0..41111] of boolean;
  x,y,pred,last,xm,ym,ca,cb: array [0..41111] of longint;

procedure Sort(l,r:longint);
var
  i,j,pp,xx,yy,tmp: longint;
begin
  i:=l; j:=r;
  pp:=l+random(r-l+1);
  xx:=x[pp]; yy:=y[pp];
  repeat
    while x[i]*yy > xx*y[i] do inc(i);
    while x[j]*yy < xx*y[j] do dec(j);
    if i <= j then
    begin
      tmp:=x[i]; x[i]:=x[j]; x[j]:=tmp;
      tmp:=y[i]; y[i]:=y[j]; y[j]:=tmp;
      inc(i); dec(j);
    end;
  until i > j;
  if l < j then Sort(l,j);
  if i < r then Sort(i,r);
end;

begin
  randseed:=8753;
//  assign(input,'in'); reset(input);
//  assign(output,'out'); rewrite(output);
  read(n);
  fillchar(can,sizeof(can),False);
  for a:=0 to 200 do
    for b:=0 to 200 do
      if a*a+b*b <= 40000 then
      begin
        can[a*a+b*b]:=True;
        ca[a*a+b*b]:=a;
        cb[a*a+b*b]:=b;
      end;
  m:=0;
  for i:=1 to 40000 do
    if can[i] then
    begin
      inc(m);
      xm[m]:=ca[i];
      ym[m]:=cb[i];
      if m = n+1 then break;
    end;
  sx:=0; sy:=0;
  for i:=1 to n do
  begin
    inc(sx,xm[i]);
    inc(sy,ym[i]);
  end;
  if (sx+sy) and 1 = 1 then
  begin
    inc(sx,xm[n+1]);
    inc(sy,ym[n+1]);
    for i:=1 to n do
      if ((sx-xm[i])+(sy-ym[i])) and 1 = 0 then
      begin
        dec(sx,xm[i]);
//        dec(sy,ym[i]);
        xm[i]:=xm[n+1];
        ym[i]:=ym[n+1];
        break;
      end;
  end;
  if sx and 1 = 1 then
    for i:=1 to n do
      if (xm[i]+ym[i]) and 1 = 1 then
      begin
        tmp:=xm[i];
        xm[i]:=ym[i];
        ym[i]:=tmp;
        break;
      end;
  fillchar(last,sizeof(last),0);
  for i:=1 to n do
  begin
    pred[i]:=last[xm[i]];
    last[xm[i]]:=i;
  end;
  sum:=0;
  for a:=200 downto 0 do
  begin
    j:=last[a];
    while j > 0 do
    begin
      if sum > 0 then xm[j]:=-xm[j];
      inc(sum,xm[j]);
      j:=pred[j];
    end;
  end;
  fillchar(last,sizeof(last),0);
  for i:=1 to n do
  begin
    pred[i]:=last[ym[i]];
    last[ym[i]]:=i;
  end;
  sum:=0;
  for a:=200 downto 0 do
  begin
    j:=last[a];
    while j > 0 do
    begin
      if sum > 0 then ym[j]:=-ym[j];
      inc(sum,ym[j]);
      j:=pred[j];
    end;
  end;
  writeln('YES');
  m:=0;
  for i:=1 to n do
    if (ym[i] > 0) or (ym[i] = 0) and (xm[i] > 0) then
    begin
      inc(m);
      x[m]:=xm[i];
      y[m]:=ym[i];
    end;
  if m > 0 then Sort(1,m);
  sx:=0; sy:=0;
  for i:=1 to m do
  begin
    writeln(sx,' ',sy);
    sx:=sx+x[i];
    sy:=sy+y[i];
  end;
  m:=0;
  for i:=1 to n do
    if not ((ym[i] > 0) or (ym[i] = 0) and (xm[i] > 0)) then
    begin
      inc(m);
      x[m]:=xm[i];
      y[m]:=-ym[i];
    end;
  if m > 0 then Sort(1,m);
  for i:=m downto 1 do
  begin
    writeln(sx,' ',sy);
    sx:=sx+x[i];
    sy:=sy-y[i];
  end;
  close(input);
  close(output);
end.


var
  c, d, e, n, p, n1: integer;

begin
  read(n, p);
  c := 0;
  while n = n do
  begin
    n := n - p;
    c := c + 1;
    d := 1;
    while d <= n do d := d * 2;
    n1 := n;
    e := 0;
    while n1 > 0 do
    begin
      if d <= n1 then
      begin
        n1 := n1 - d;
        e := e + 1;
      end;
      d := d div 2;
    end;
    if (n < c) then
    begin
      write('-1');
      break;
    end
    else if e <= c then
    begin
      write(c);
      break;
    end;
  end;
end.

                                             const eps=1e-12;
                          besk=2002000000000000000; label 4,1,3,2,44,22;
                    type mas=array[-100..1200000+1] of int64;
                    integer=longint;    zap=record p1,p2,p3:int64; end;
                    zap1=^zap;
                    var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                    ss3,ss,ss1,ss2:string;
                    qqq:zap;  pmin,bet,al:extended;
                    ot1,ot2:zap;
                    ver:array[-1..500,-1..5] of extended;
                    verugad:array[-2..200,-2..200,-2..200] of extended;
                    vhod,kolzan,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,sum,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                      z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                     vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                      zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                      ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                      ppole:array[-1000000..3000000] of char;
                      str1,str2,stroka:array[-1000..1000000] of char;
                      dinam:array[-100000..1000000] of extended;
                      t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                      dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                      sp,sss:array[-10..2000000] of string;
                      newpole,pole:array[-1..2100,-1..2700] of char;
                      blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                      poss:int64;
                      ch:char;
                      ff,flagg1:boolean;
                      oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                      dddd:array[-10..5010,-10..5010] of int64;
                     function srav(i,j:longint):boolean; label 44;

                    begin
                       if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                       if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                       if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                     44:
                    end;

                    procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                    begin
                    i:=l;j:=m; flag:=true; step:=0;while flag do begin
                    if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                    inc(step);inc(i);
                    {writeln('step=',step,' i=',i);} end;
                    if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                    inc(step);inc(j);end;
                    if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                    end;
                    if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                    if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                    end;
                    procedure sort(var c:mas);

                    begin

                    k:=1; repeat
                    l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                    for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                    until (k>=n);

                    end;

                    function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                    function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                    function min3(a,b,c:int64):int64;  var ot:int64;
                    begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

          function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
      tt:zap; tt1:zap1;  fl:boolean;
    begin
      fl:=false;
      if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
      x2:=1;x1:=0;y2:=0;y1:=1;
      while b>0 do
        begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
              a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
        end;
        if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
             begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
       evkl:=tt1;
    end;

                    function phi(a,b:double):double; label 222;var p:double;
                    begin
                      if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                      if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                      if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                      if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                      if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                      222: phi:=p;
                    end;

                    function nod(a,b:int64):int64; var p,t:int64;
                    begin
                      a:=abs(a); b:=abs(b);
                      if (a>0)and(b>0) then
                       begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                        p:=a;
                       end else if a=0 then p:=b else p:=a;
                    nod:=p;
                    end;
              function arccos(tt:extended):extended;
      begin
        if abs(tt)>1-1e-13 then
        if tt>0 then  arccos:=0 else arccos:=pi;
        if tt=0 then arccos:=pi/2 else
        if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
        else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

      end;

                    function nok(a,b:int64):int64;
                    begin  nok:=(a*b) div nod(a,b);  end;

                       function degg(a:int64;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 div 2); degg:=(p*p) mod modul;    end;

                    end;

          {          function zaprmax(left,right:longint):int64;
                begin
                   if left>=right then zaprmax:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                         begin
                          if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                          if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                         end;

                     end;

                end;
           }
              function zaprmin(left,right:longint):int64;
                begin
                   if left>=right then zaprmin:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                         begin
                          if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                          if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                         end;

                     end;

                end;

                    procedure udal(ii:longint);
                    begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                    function nomerr(gr:int64):int64;

                    var ot,aa,bb,cc:int64; fl:boolean;
                    begin
                      aa:=1; bb:=p;  cc:=aa; fl:=false;
                      while abs(aa-bb)>1 do
                        begin
                           cc:=(aa+bb) shr 1;
                           writeln('cc=++ ',cc);
                           if y[cc]<gr then aa:=cc else bb:=cc;

                        end;
                       writeln(' cc= ',cc);
                     {  cc:=max(cc-3,0);
                     }  repeat inc(cc) until y[cc]>=gr;
                       if y[cc]=gr then fl:=true else fl:=false;
                        if fl then nomerr:=a1[cc] else nomerr:=-1000;
                       nomerr:=cc;
                    end;

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

                     pprost:=fl;

                    end;

                    function gl(c:char):boolean;
                    begin
                     if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                    end;

    function koled(t:int64):longint;
    var p,i,j,ans:longint;
    begin
       ans:=0;
       while t>0 do begin ans:=ans+t and 1; t:=t shr 1;  end;
       koled:=ans;
    end;

     begin
      {  assign (input,'D:\Projects\input.txt');reset(input);
          assign (output,'D:\Projects\output.txt'); rewrite(output);
       }
          read(vhod,p);
          z[0]:=1;
          for i:=1 to 32 do z[i]:=z[i-1]*2;
          for i:=1 to 32 do z[i]:=z[i]+p;

        {  for i:=1 to 20 do writeln(i,' ',koled(i));
        }    ans:=100000000000000;
          for step:=0 to 10000000 do
             begin
               ii:=step;
               t:=vhod-ii*p;

             if t>0 then
              begin
                { writeln('t= ',t,'  koled= ',koled(t));
                } if (koled(t)<=step)and(step<=t) then ans:=min(ans,step);
              end;
             end;

           if ans<10000000000 then write(ans) else write(-1);

          1: close (output);
        end.

var n,p,i:longint;
function count(x:longint):longint;
var tot:longint;
begin
  tot:=0;
  while x>0 do
  begin
    if (x and 1)>0 then inc(tot);
    x:=x div 2;
  end;
  exit(tot);
end;
begin
  readln(n,p);
  for i:=1 to 31 do
    if (n-i*p>=i) and (count(n-i*p)<=i) then begin writeln(i);exit;end;
  writeln(-1);
end.

                                             const eps=1e-12;
                          besk=2002000000000000000; label 4,1,3,2,44,22;
                    type mas=array[-100..1200000+1] of int64;
                    integer=longint;    zap=record p1,p2,p3:int64; end;
                    zap1=^zap;
                    var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                    ss3,ss,ss1,ss2:string;
                    qqq:zap;  pmin,bet,al:extended;
                    ot1,ot2:zap;
                    ver:array[-1..500,-1..5] of extended;
                    verugad:array[-2..200,-2..200,-2..200] of extended;
                    vhod,kolzan,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,sum,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                      z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                     vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                      zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                      ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                      ppole:array[-1000000..3000000] of char;
                      str1,str2,stroka:array[-1000..1000000] of char;
                      dinam:array[-100000..1000000] of extended;
                      t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                      dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                      sp,sss:array[-10..2000000] of string;
                      newpole,pole:array[-1..2100,-1..2700] of char;
                      blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                      poss:int64;
                      ch:char;
                      ff,flagg1:boolean;
                      oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                      dddd:array[-10..5010,-10..5010] of int64;
                     function srav(i,j:longint):boolean; label 44;

                    begin
                       if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                       if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                       if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                     44:
                    end;

                    procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                    begin
                    i:=l;j:=m; flag:=true; step:=0;while flag do begin
                    if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                    inc(step);inc(i);
                    {writeln('step=',step,' i=',i);} end;
                    if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                    inc(step);inc(j);end;
                    if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                    end;
                    if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                    if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                    end;
                    procedure sort(var c:mas);

                    begin

                    k:=1; repeat
                    l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                    for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                    until (k>=n);

                    end;

                    function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                    function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                    function min3(a,b,c:int64):int64;  var ot:int64;
                    begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

          function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
      tt:zap; tt1:zap1;  fl:boolean;
    begin
      fl:=false;
      if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
      x2:=1;x1:=0;y2:=0;y1:=1;
      while b>0 do
        begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
              a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
        end;
        if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
             begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
       evkl:=tt1;
    end;

                    function phi(a,b:double):double; label 222;var p:double;
                    begin
                      if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                      if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                      if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                      if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                      if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                      222: phi:=p;
                    end;

                    function nod(a,b:int64):int64; var p,t:int64;
                    begin
                      a:=abs(a); b:=abs(b);
                      if (a>0)and(b>0) then
                       begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                        p:=a;
                       end else if a=0 then p:=b else p:=a;
                    nod:=p;
                    end;
              function arccos(tt:extended):extended;
      begin
        if abs(tt)>1-1e-13 then
        if tt>0 then  arccos:=0 else arccos:=pi;
        if tt=0 then arccos:=pi/2 else
        if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
        else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

      end;

                    function nok(a,b:int64):int64;
                    begin  nok:=(a*b) div nod(a,b);  end;

                       function degg(a:int64;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 div 2); degg:=(p*p) mod modul;    end;

                    end;

          {          function zaprmax(left,right:longint):int64;
                begin
                   if left>=right then zaprmax:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                         begin
                          if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                          if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                         end;

                     end;

                end;
           }
              function zaprmin(left,right:longint):int64;
                begin
                   if left>=right then zaprmin:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                         begin
                          if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                          if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                         end;

                     end;

                end;

                    procedure udal(ii:longint);
                    begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                    function nomerr(gr:int64):int64;

                    var ot,aa,bb,cc:int64; fl:boolean;
                    begin
                      aa:=1; bb:=p;  cc:=aa; fl:=false;
                      while abs(aa-bb)>1 do
                        begin
                           cc:=(aa+bb) shr 1;
                           writeln('cc=++ ',cc);
                           if y[cc]<gr then aa:=cc else bb:=cc;

                        end;
                       writeln(' cc= ',cc);
                     {  cc:=max(cc-3,0);
                     }  repeat inc(cc) until y[cc]>=gr;
                       if y[cc]=gr then fl:=true else fl:=false;
                        if fl then nomerr:=a1[cc] else nomerr:=-1000;
                       nomerr:=cc;
                    end;

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

                     pprost:=fl;

                    end;

                    function gl(c:char):boolean;
                    begin
                     if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                    end;

    function koled(t:int64):longint;
    var p,i,j,ans:longint;
    begin
       ans:=0;
       while t>0 do begin ans:=ans+t and 1; t:=t shr 1;  end;
       koled:=ans;
    end;

     begin
      {  assign (input,'D:\Projects\input.txt');reset(input);
          assign (output,'D:\Projects\output.txt'); rewrite(output);
       }
          read(vhod,p);
          z[0]:=1;
          for i:=1 to 32 do z[i]:=z[i-1]*2;
          for i:=1 to 32 do z[i]:=z[i]+p;

        {  for i:=1 to 20 do writeln(i,' ',koled(i));
        }    ans:=100000000000000;
          for step:=0 to 100000 do
             begin
               ii:=step;
               t:=vhod-ii*p;

             if t>0 then
              begin
                { writeln('t= ',t,'  koled= ',koled(t));
                } if (koled(t)<=step)and(step<=t) then ans:=min(ans,step);
              end;
             end;

           if ans<10000000000 then write(ans) else write(-1);

          1: close (output);
        end.

                                             const eps=1e-12;
                          besk=2002000000000000000; label 4,1,3,2,44,22;
                    type mas=array[-100..1200000+1] of int64;
                    integer=longint;    zap=record p1,p2,p3:int64; end;
                    zap1=^zap;
                    var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                    ss3,ss,ss1,ss2:string;
                    qqq:zap;  pmin,bet,al:extended;
                    ot1,ot2:zap;
                    ver:array[-1..500,-1..5] of extended;
                    verugad:array[-2..200,-2..200,-2..200] of extended;
                    vhod,kolzan,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,sum,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                      z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                     vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                      zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                      ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                      ppole:array[-1000000..3000000] of char;
                      str1,str2,stroka:array[-1000..1000000] of char;
                      dinam:array[-100000..1000000] of extended;
                      t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                      dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                      sp,sss:array[-10..2000000] of string;
                      newpole,pole:array[-1..2100,-1..2700] of char;
                      blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                      poss:int64;
                      ch:char;
                      ff,flagg1:boolean;
                      oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                      dddd:array[-10..5010,-10..5010] of int64;
                     function srav(i,j:longint):boolean; label 44;

                    begin
                       if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                       if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                       if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                     44:
                    end;

                    procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                    begin
                    i:=l;j:=m; flag:=true; step:=0;while flag do begin
                    if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                    inc(step);inc(i);
                    {writeln('step=',step,' i=',i);} end;
                    if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                    inc(step);inc(j);end;
                    if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                    end;
                    if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                    if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                    end;
                    procedure sort(var c:mas);

                    begin

                    k:=1; repeat
                    l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                    for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                    until (k>=n);

                    end;

                    function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                    function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                    function min3(a,b,c:int64):int64;  var ot:int64;
                    begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

          function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
      tt:zap; tt1:zap1;  fl:boolean;
    begin
      fl:=false;
      if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
      x2:=1;x1:=0;y2:=0;y1:=1;
      while b>0 do
        begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
              a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
        end;
        if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
             begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
       evkl:=tt1;
    end;

                    function phi(a,b:double):double; label 222;var p:double;
                    begin
                      if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                      if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                      if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                      if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                      if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                      222: phi:=p;
                    end;

                    function nod(a,b:int64):int64; var p,t:int64;
                    begin
                      a:=abs(a); b:=abs(b);
                      if (a>0)and(b>0) then
                       begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                        p:=a;
                       end else if a=0 then p:=b else p:=a;
                    nod:=p;
                    end;
              function arccos(tt:extended):extended;
      begin
        if abs(tt)>1-1e-13 then
        if tt>0 then  arccos:=0 else arccos:=pi;
        if tt=0 then arccos:=pi/2 else
        if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
        else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

      end;

                    function nok(a,b:int64):int64;
                    begin  nok:=(a*b) div nod(a,b);  end;

                       function degg(a:int64;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 div 2); degg:=(p*p) mod modul;    end;

                    end;

          {          function zaprmax(left,right:longint):int64;
                begin
                   if left>=right then zaprmax:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                         begin
                          if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                          if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                         end;

                     end;

                end;
           }
              function zaprmin(left,right:longint):int64;
                begin
                   if left>=right then zaprmin:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                         begin
                          if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                          if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                         end;

                     end;

                end;

                    procedure udal(ii:longint);
                    begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                    function nomerr(gr:int64):int64;

                    var ot,aa,bb,cc:int64; fl:boolean;
                    begin
                      aa:=1; bb:=p;  cc:=aa; fl:=false;
                      while abs(aa-bb)>1 do
                        begin
                           cc:=(aa+bb) shr 1;
                           writeln('cc=++ ',cc);
                           if y[cc]<gr then aa:=cc else bb:=cc;

                        end;
                       writeln(' cc= ',cc);
                     {  cc:=max(cc-3,0);
                     }  repeat inc(cc) until y[cc]>=gr;
                       if y[cc]=gr then fl:=true else fl:=false;
                        if fl then nomerr:=a1[cc] else nomerr:=-1000;
                       nomerr:=cc;
                    end;

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

                     pprost:=fl;

                    end;

                    function gl(c:char):boolean;
                    begin
                     if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                    end;

    function koled(t:int64):longint;
    var p,i,j,ans:longint;
    begin
       ans:=0;
       while t>0 do begin ans:=ans+t and 1; t:=t shr 1;  end;
       koled:=ans;
    end;

     begin
      {  assign (input,'D:\Projects\input.txt');reset(input);
          assign (output,'D:\Projects\output.txt'); rewrite(output);
       }
          read(vhod,p);
          z[0]:=1;
          for i:=1 to 32 do z[i]:=z[i-1]*2;
          for i:=1 to 32 do z[i]:=z[i]+p;

        {  for i:=1 to 20 do writeln(i,' ',koled(i));
        }    ans:=100000000000000;
          for step:=0 to 1000000 do
             begin
               ii:=step;
               t:=vhod-ii*p;

             if t>0 then
              begin
                { writeln('t= ',t,'  koled= ',koled(t));
                } if (koled(t)<=step)and(step<=t) then ans:=min(ans,step);
              end;
             end;

           if ans<10000000000 then write(ans) else write(-1);

          1: close (output);
        end.

var n,p,i:longint;
function count(x:longint):longint;
var tot:longint;
begin
  tot:=0;
  while x>0 do
  begin
    if (x and 1)>0 then inc(tot);
    x:=x div 2;
  end;
  exit(tot);
end;
begin
  readln(n,p);
  for i:=1 to 31 do
    if (n-i*p>0) and (count(n-i*p)<=i) then begin writeln(i);exit;end;
  writeln(-1);
end.

                                             const eps=1e-12;
                          besk=2002000000000000000; label 4,1,3,2,44,22;
                    type mas=array[-100..1200000+1] of int64;
                    integer=longint;    zap=record p1,p2,p3:int64; end;
                    zap1=^zap;
                    var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                    ss3,ss,ss1,ss2:string;
                    qqq:zap;  pmin,bet,al:extended;
                    ot1,ot2:zap;
                    ver:array[-1..500,-1..5] of extended;
                    verugad:array[-2..200,-2..200,-2..200] of extended;
                    vhod,kolzan,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,sum,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                      z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                     vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                      zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                      ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                      ppole:array[-1000000..3000000] of char;
                      str1,str2,stroka:array[-1000..1000000] of char;
                      dinam:array[-100000..1000000] of extended;
                      t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                      dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                      sp,sss:array[-10..2000000] of string;
                      newpole,pole:array[-1..2100,-1..2700] of char;
                      blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                      poss:int64;
                      ch:char;
                      ff,flagg1:boolean;
                      oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                      dddd:array[-10..5010,-10..5010] of int64;
                     function srav(i,j:longint):boolean; label 44;

                    begin
                       if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                       if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                       if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                     44:
                    end;

                    procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                    begin
                    i:=l;j:=m; flag:=true; step:=0;while flag do begin
                    if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                    inc(step);inc(i);
                    {writeln('step=',step,' i=',i);} end;
                    if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                    inc(step);inc(j);end;
                    if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                    end;
                    if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                    if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                    end;
                    procedure sort(var c:mas);

                    begin

                    k:=1; repeat
                    l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                    for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                    until (k>=n);

                    end;

                    function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                    function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                    function min3(a,b,c:int64):int64;  var ot:int64;
                    begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

          function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
      tt:zap; tt1:zap1;  fl:boolean;
    begin
      fl:=false;
      if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
      x2:=1;x1:=0;y2:=0;y1:=1;
      while b>0 do
        begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
              a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
        end;
        if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
             begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
       evkl:=tt1;
    end;

                    function phi(a,b:double):double; label 222;var p:double;
                    begin
                      if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                      if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                      if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                      if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                      if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                      222: phi:=p;
                    end;

                    function nod(a,b:int64):int64; var p,t:int64;
                    begin
                      a:=abs(a); b:=abs(b);
                      if (a>0)and(b>0) then
                       begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                        p:=a;
                       end else if a=0 then p:=b else p:=a;
                    nod:=p;
                    end;
              function arccos(tt:extended):extended;
      begin
        if abs(tt)>1-1e-13 then
        if tt>0 then  arccos:=0 else arccos:=pi;
        if tt=0 then arccos:=pi/2 else
        if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
        else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

      end;

                    function nok(a,b:int64):int64;
                    begin  nok:=(a*b) div nod(a,b);  end;

                       function degg(a:int64;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 div 2); degg:=(p*p) mod modul;    end;

                    end;

          {          function zaprmax(left,right:longint):int64;
                begin
                   if left>=right then zaprmax:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                         begin
                          if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                          if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                         end;

                     end;

                end;
           }
              function zaprmin(left,right:longint):int64;
                begin
                   if left>=right then zaprmin:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                         begin
                          if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                          if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                         end;

                     end;

                end;

                    procedure udal(ii:longint);
                    begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                    function nomerr(gr:int64):int64;

                    var ot,aa,bb,cc:int64; fl:boolean;
                    begin
                      aa:=1; bb:=p;  cc:=aa; fl:=false;
                      while abs(aa-bb)>1 do
                        begin
                           cc:=(aa+bb) shr 1;
                           writeln('cc=++ ',cc);
                           if y[cc]<gr then aa:=cc else bb:=cc;

                        end;
                       writeln(' cc= ',cc);
                     {  cc:=max(cc-3,0);
                     }  repeat inc(cc) until y[cc]>=gr;
                       if y[cc]=gr then fl:=true else fl:=false;
                        if fl then nomerr:=a1[cc] else nomerr:=-1000;
                       nomerr:=cc;
                    end;

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

                     pprost:=fl;

                    end;

                    function gl(c:char):boolean;
                    begin
                     if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                    end;

    function koled(t:int64):longint;
    var p,i,j,ans:longint;
    begin
       ans:=0;
       while t>0 do begin ans:=ans+t and 1; t:=t shr 1;  end;
       koled:=ans;
    end;

     begin
      {  assign (input,'D:\Projects\input.txt');reset(input);
          assign (output,'D:\Projects\output.txt'); rewrite(output);
       }
          read(vhod,p);
          z[0]:=1;
          for i:=1 to 32 do z[i]:=z[i-1]*2;
          for i:=1 to 32 do z[i]:=z[i]+p;

        {  for i:=1 to 20 do writeln(i,' ',koled(i));
        }    ans:=100000000000000;
          for step:=0 to 10000000 do
             begin
               ii:=step;
               t:=vhod-ii*p;

             if t>0 then
              begin
                { writeln('t= ',t,'  koled= ',koled(t));
                } if koled(t)<=step then ans:=min(ans,step);
              end;
             end;

           if ans<10000000000 then write(ans) else write(-1);

          1: close (output);
        end.

                                  const eps=1e-12;
                      besk=2002000000000000000; label 4,1,3,2,44,22;
                type mas=array[-100..1200000+1] of int64;
                integer=longint;    zap=record p1,p2,p3:int64; end;
                zap1=^zap;
                var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                ss3,ss,ss1,ss2:string;
                qqq:zap;  pmin,bet,al:extended;
                ot1,ot2:zap;
                ver:array[-1..500,-1..5] of extended;
                verugad:array[-2..200,-2..200,-2..200] of extended;
                vhod,kolzan,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,sum,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                  z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                 vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                  zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                  ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                  ppole:array[-1000000..3000000] of char;
                  str1,str2,stroka:array[-1000..1000000] of char;
                  dinam:array[-100000..1000000] of extended;
                  t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                  dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                  sp,sss:array[-10..2000000] of string;
                  newpole,pole:array[-1..2100,-1..2700] of char;
                  blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                  poss:int64;
                  ch:char;
                  ff,flagg1:boolean;
                  oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                  dddd:array[-10..5010,-10..5010] of int64;
                 function srav(i,j:longint):boolean; label 44;

                begin
                   if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                   if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                   if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                 44:
                end;

                procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                begin
                i:=l;j:=m; flag:=true; step:=0;while flag do begin
                if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                inc(step);inc(i);
                {writeln('step=',step,' i=',i);} end;
                if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                inc(step);inc(j);end;
                if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                end;
                if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                end;
                procedure sort(var c:mas);

                begin

                k:=1; repeat
                l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                until (k>=n);

                end;

                function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                function min3(a,b,c:int64):int64;  var ot:int64;
                begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

      function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
  tt:zap; tt1:zap1;  fl:boolean;
begin
  fl:=false;
  if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
  x2:=1;x1:=0;y2:=0;y1:=1;
  while b>0 do
    begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
          a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
    end;
    if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
         begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
   evkl:=tt1;
end;

                function phi(a,b:double):double; label 222;var p:double;
                begin
                  if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                  if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                  if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                  if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                  if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                  222: phi:=p;
                end;

                function nod(a,b:int64):int64; var p,t:int64;
                begin
                  a:=abs(a); b:=abs(b);
                  if (a>0)and(b>0) then
                   begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                    p:=a;
                   end else if a=0 then p:=b else p:=a;
                nod:=p;
                end;
          function arccos(tt:extended):extended;
  begin
    if abs(tt)>1-1e-13 then
    if tt>0 then  arccos:=0 else arccos:=pi;
    if tt=0 then arccos:=pi/2 else
    if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
    else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

  end;

                function nok(a,b:int64):int64;
                begin  nok:=(a*b) div nod(a,b);  end;

                   function degg(a:int64;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 div 2); degg:=(p*p) mod modul;    end;

                end;

      {          function zaprmax(left,right:longint):int64;
            begin
               if left>=right then zaprmax:=y[left] else
                 begin
                    if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                     begin
                      if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                      if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                     end;

                 end;

            end;
       }
          function zaprmin(left,right:longint):int64;
            begin
               if left>=right then zaprmin:=y[left] else
                 begin
                    if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                     begin
                      if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                      if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                     end;

                 end;

            end;

                procedure udal(ii:longint);
                begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                function nomerr(gr:int64):int64;

                var ot,aa,bb,cc:int64; fl:boolean;
                begin
                  aa:=1; bb:=p;  cc:=aa; fl:=false;
                  while abs(aa-bb)>1 do
                    begin
                       cc:=(aa+bb) shr 1;
                       writeln('cc=++ ',cc);
                       if y[cc]<gr then aa:=cc else bb:=cc;

                    end;
                   writeln(' cc= ',cc);
                 {  cc:=max(cc-3,0);
                 }  repeat inc(cc) until y[cc]>=gr;
                   if y[cc]=gr then fl:=true else fl:=false;
                    if fl then nomerr:=a1[cc] else nomerr:=-1000;
                   nomerr:=cc;
                end;

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

                 pprost:=fl;

                end;

                function gl(c:char):boolean;
                begin
                 if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                end;

function koled(t:int64):longint;
var p,i,j,ans:longint;
begin
   ans:=0;
   while t>0 do begin ans:=ans+t and 1; t:=t shr 1;  end;
   koled:=ans;
end;

 begin
   { assign (input,'D:\Projects\input.txt');reset(input);
      assign (output,'D:\Projects\output.txt'); rewrite(output);
    }
      read(vhod,p);
      z[0]:=1;
      for i:=1 to 32 do z[i]:=z[i-1]*2;
      for i:=1 to 32 do z[i]:=z[i]+p;

    {  for i:=1 to 20 do writeln(i,' ',koled(i));
    }    ans:=100000000000000;
      for step:=0 to 1000000 do
         begin
           ii:=step;
           t:=vhod-ii*p;

         if t>0 then
          begin
            { writeln('t= ',t,'  koled= ',koled(t));
            } if koled(t)<=step then begin ans:=min(ans,step); goto 2;  end;
          end;
         end;

   2:    if ans<10000000000 then write(ans) else write(-1);

      1: close (output);
    end.

var
  c, d, e, n, p, n1: integer;

begin
  read(n, p);
  c := 0;
  while n = n do
  begin
    n := n - p;
    c := c + 1;
    d := 1;
    while d <= n do d := d * 2;
    n1 := n;
    e := 0;
    while n1 > 0 do
    begin
      if d <= n1 then
      begin
        n1 := n1 - d;
        e := e + 1;
      end;
      d := d div 2;
    end;
    if (n <= 0) then
    begin
      write('-1');
      break;
    end
    else if e <= c then
    begin
      write(c);
      break;
    end;
  end;
end.

var
  c, d, e, n, p, n1: integer;

begin
  read(n, p);
  c := 0;
  while n = n do
  begin
    n := n - p;
    c := c + 1;
    d := 1;
    while d <= n do d := d * 2;
    n1 := n;
    e := 0;
    while n1 > 0 do
    begin
      if d <= n1 then
      begin
        n1 := n1 - d;
        e := e + 1;
      end;
      d := d div 2;
    end;
    if (n <= 1) then
    begin
      write('-1');
      break;
    end
    else if e <= c then
    begin
      write(c);
      break;
    end;
  end;
end.

var
  c, d, e, n, p, n1: integer;

begin
  read(n, p);
  c := 0;
  while n = n do
  begin
    n := n - p;
    c := c + 1;
    d := 1;
    while d <= n do d := d * 2;
    n1 := n;
    e := 0;
    while n1 > 0 do
    begin
      if d <= n1 then
      begin
        n1 := n1 - d;
        e := e + 1;
      end;
      d := d div 2;
    end;
    if (n <= 0) or ((n = 1) and (p <> 0)) then
    begin
      write('-1');
      break;
    end
    else if e <= c then
    begin
      write(c);
      break;
    end;
  end;
end.