Petya loves lucky numbers. Everybody knows that lucky numbers are positive integers whose decimal representation contains only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.One day Petya dreamt of a lexicographically k-th permutation of integers from 1 to n. Determine how many lucky numbers in the permutation are located on the positions whose indexes are also lucky numbers.

The first line contains two integers n and k (1 ≤ n, k ≤ 109) — the number of elements in the permutation and the lexicographical number of the permutation.

If the k-th permutation of numbers from 1 to n does not exist, print the single number "-1" (without the quotes). Otherwise, print the answer to the problem: the number of such indexes i, that i and ai are both lucky numbers.

NoteA permutation is an ordered set of n elements, where each integer from 1 to n occurs exactly once. The element of permutation in position with index i is denoted as ai (1 ≤ i ≤ n). Permutation a is lexicographically smaller that permutation b if there is such a i (1 ≤ i ≤ n), that ai < bi, and for any j (1 ≤ j < i) aj = bj. Let's make a list of all possible permutations of n elements and sort it in the order of lexicographical increasing. Then the lexicographically k-th permutation is the k-th element of this list of permutations.In the first sample the permutation looks like that:1 2 3 4 6 7 5The only suitable position is 4.In the second sample the permutation looks like that:2 1 3 4The only suitable position is 4.

program cf121c;
var
  n,i,j,xx,jj,nn:longint;
  jc:array[0..1000]of int64;
  kk,ans,t:int64;
  dl,ne,xl:array[0..10000]of int64;
procedure dfs(o:int64);
begin
  if o<=4444444444 then begin
    inc(dl[0]);
   // writeln(o);
    dl[dl[0]]:=o;
    dfs(o*10+4);
    dfs(o*10+7);
  end;
end;

function kind(x:longint):boolean;
begin
  while x<>0 do begin
    if (x mod 10<>4)and(x mod 10<>7) then exit(false);
    x:=x div 10;
  end;
  exit(true);
end;

begin
  dl[0]:=0;
  dfs(4);
  dfs(7);

  for i:=1 to dl[0] do
    for j:=i+1 to dl[0] do
      if dl[j]<dl[i] then begin
        t:=dl[i];dl[i]:=dl[j];dl[j]:=t;
      end;

//init-----------------------------/

  jc[0]:=1;
  for i:=1 to 1000 do begin
    jc[i]:=jc[i-1]*i;
    if jc[i]>1000000000 then break;
  end;
  readln(n,kk);

  j:=n;
  while (jc[n-j+1]<kk) do begin
    dec(j);
    if j=0 then begin
      writeln(-1);
      halt;
    end;
  end;

  ans:=0;
  for i:=1 to dl[0] do
    if dl[i]<j then inc(ans);

  jj:=j-1;
  nn:=n-j+1;
  for i:=1 to nn do ne[i-1]:=i;
  for i:=1 to nn do begin
    xx:=0;
    j:=ne[0];
    while kk>jc[nn-i] do begin
      xx:=j;
      j:=ne[j];
      kk:=kk-jc[nn-i];
    end;
    ne[xx]:=ne[j];
    xl[i]:=j;
  end;

  for i:=1 to nn do
    if (kind(jj+xl[i]))and(kind(jj+i)) then inc(ans);
  writeln(ans);
end.

var
        z:int64;
        p:array[0..1025]of boolean;
        a,s:array[0..1025]of int64;
        ans,n,m,x,i,j,k,t:Longint;

function pd(x:longint):boolean;
begin
        while x>0 do begin
          if (x mod 10<>4) and (x mod 10<>7) then exit(false);
          x:=x div 10;
        end;
        exit(true);
end;

begin
        s[0]:=1; for i:=1 to 13 do s[i]:=s[i-1]*i;
        read(n,m); dec(m);
        if (n<=13) and (m+1>s[n]) then begin writeln(-1); exit end;
        t:=13; if t>n then t:=n; k:=n-t+1;
        a[1]:=4; a[2]:=7; j:=2; i:=0;
        repeat
          inc(i);
          z:=a[i]*10+4; if z<k then begin inc(j); a[j]:=z end;
          z:=z+3;       if z<k then begin inc(j); a[j]:=z end;
        until i=j;
        if k<=4 then ans:=0 else if k<=7 then ans:=1 else ans:=j; x:=t;
        for i:=k to n do begin
          dec(t);
          z:=m div s[t]; m:=m mod s[t];
          for j:=1 to x do begin
            if (z=0) and not p[j] then begin p[j]:=true; break; end;
            if not p[j] then dec(z);
          end;
          if pd(j+k-1) and pd(i) then inc(ans);
        end;
        writeln(ans);
end.

{$R+,S+,Q+,I+,O-}
{R-,S-,Q-,I-,O+}
var
  f: array [0..99] of int64;
  n,k,i,j,m,x,y,ans: longint;
  was: array [0..99] of boolean;

procedure rec(w:int64);
begin
  if w <= n-m then
  begin
    inc(ans);
    rec(w*10+4);
    rec(w*10+7);
  end;
end;

function lucky(t:int64):boolean;
begin
  while t > 0 do
  begin
    if (t mod 10 <> 4) and (t mod 10 <> 7) then
    begin
      lucky:=False;
      exit;
    end;
    t:=t div 10;
  end;
  lucky:=True;
end;

begin
//  assign(input,'in'); reset(input);
//  assign(output,'out'); rewrite(output);
  f[0]:=1;
  for i:=1 to 14 do f[i]:=f[i-1]*i;
  read(n,k);
  m:=0;
  for i:=1 to n do
    if f[i] >= k then
    begin
      m:=i;
      break;
    end;
  if m = 0 then
  begin
    writeln('-1');
    halt;
  end;
  ans:=0;
  rec(4); rec(7);
  fillchar(was,sizeof(was),False);
  for i:=1 to m do
  begin
    x:=0; y:=1;
    while k > f[m-i] do
    begin
      k:=k-f[m-i];
      inc(y);
    end;
    for j:=1 to y do
    begin
      inc(x);
      while was[x] do inc(x);
    end;
    was[x]:=True;
    if lucky(n-m+i) and lucky(n-m+x) then inc(ans);
  end;
  writeln(ans);
  close(input);
  close(output);
end.

{$MODE OBJFPC}
//(a/b) mod p=a*(b^(p-2)) mod p
const
  fo='';
  fi='';
var
  n,k,kq:integer;
  tt:int64;
  head:integer;
  first,last:integer;
  p:array[1..100000] of int64;
  ak:array[0..15] of int64;
  a:array[1..15] of integer;
procedure input;
var f:textfile; i,j:integer;
begin
  assign(f,fo);
  reset(f);
  readln(f,n,k);
  close(f);
end;
procedure find;
var i,j:int64;
begin
  i:=1;
  j:=1;
  ak[1]:=1;
  ak[0]:=0;
  while k>i do
  begin
    inc(j);
    i:=i*j;
    ak[j]:=i;
  end;
  head:=n;
  while (head>=0) and (k>ak[n-head]) do dec(head);
end;
procedure init;
begin
  first:=1;
  last:=0;
end;
procedure push(i:integer);
begin
  inc(last);
  p[last]:=i;
end;
function pop:integer;
begin
  result:=p[first];
  inc(first);
end;
procedure solve;
var i,j,u,v:int64;
begin
  init;
  push(4);
  push(7);
  kq:=0;
  if 4<=head then inc(kq);
  if 7<=head then inc(kq);
  while first<=last do
  begin
    u:=pop;
    v:=u*10+4;
    if v<=head then begin inc(kq); push(v); end;
    v:=u*10+7;
    if v<=head then begin inc(kq); push(v); end;
  end;
end;
procedure QS(l,h:integer);
var i,j:integer; pivot:integer;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l]; i:=l; j:=h;
  repeat
  while (i<j) and (a[j]>pivot) do dec(j);
  if i<j then begin a[i]:=a[j]; inc(i); end else break;
  while (i<j) and (pivot>a[i]) do inc(i);
  if i<j then begin a[j]:=a[i]; dec(j); end else break;
  until i=j;
  a[i]:=pivot;
  QS(l,i-1);
  QS(i+1,h);
end;
procedure QS2(l,h:integer);
var i,j:integer; pivot:integer;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l]; i:=l; j:=h;
  repeat
  while (i<j) and (a[j]<pivot) do dec(j);
  if i<j then begin a[i]:=a[j]; inc(i); end else break;
  while (i<j) and (pivot<a[i]) do inc(i);
  if i<j then begin a[j]:=a[i]; dec(j); end else break;
  until i=j;
  a[i]:=pivot;
  QS2(l,i-1);
  QS2(i+1,h);
end;
function check(i:integer):boolean;
begin
  while i>0 do
  begin
    if ((i mod 10)<>4) and ((i mod 10)<>7) then exit(false);
    i:=i div 10;
  end;
  exit(true);
end;
procedure solve2;
var i,u,v,cc,d,t:integer;
begin
  u:=head+1;
  for i:=u to n do a[i-head]:=i;
  v:=n-head;
  cc:=0;
  while (k>1) and (cc<v) do
  begin
    inc(cc);
    if k>=ak[v-cc] then
    begin
      d:=k div ak[v-cc];
      if k mod ak[v-cc]=0 then
      begin
        d:=d+cc-1;
        t:=a[cc];
        a[cc]:=a[d];
        a[d]:=t;
        k:=0;
        QS2(cc+1,v);
      end
      else
      begin
        k:=k-d*ak[v-cc];
        d:=d+cc;
        t:=a[cc];
        a[cc]:=a[d];
        a[d]:=t;
        QS(cc+1,v);
      end;
    end;
  end;
  for i:=1 to v do
    if check(a[i]) and check(i+head) then inc(kq);
end;
procedure output;
var f:textfile; i:integer;
begin
  assign(f,fi);
  rewrite(f);
  if head<0 then writeln(f,-1) else
  writeln(f,kq);
  close(f);
end;
begin
  input;
  find;
  if head>=0 then
  begin
  solve;
  solve2;
  end;
  output;
end.

{$mode objfpc}
const
  fi = '';//lucky.inp';
  fo = '';//lucky.out';
  maxn = round(1e6);

var
  ip, op : text;
  n, k, res, xx : integer;
  a : array[0..13] of int64;
  vis : array[1..13] of boolean;
  cs : array[1..13] of integer; // so i + (n-pos) o vi tri nao
  top, last : integer;
  q : array[1..maxn] of integer;

function check(x : int64) : boolean;
var
  s : string;
  i : integer;
begin
  str(x, s);
  for i := 1 to length(s) do if (s[i] <> '4')
    and (s[i] <> '7') then exit(false);
  result := true;
end;

procedure push(x : int64);
begin
  inc(last);
  q[last] := x;
end;

function pop : int64;
begin
  result := q[top];
  inc(top);
end;

function low(x, y, z : int64) : boolean;
begin
  if x <= z/y then exit(true);
  exit(false);
end;

procedure solve;
var
  d, u, v : int64;
begin
  d := 0;
  top := 1;
  last := 0;
  push(d);
  while top <= last do
    begin
      u := pop;
      if low(u, 10, xx-4) then push(u*10+4);
      if low(u, 10, xx-7) then push(u*10+7);
    end;
  res := res + last-1;
end;

procedure process;
var
  i, pos, count, j, vj, gan, luu : integer;
  u, v, d : integer;
begin
  readln(ip, n, k);
  a[1] := 1;
  for i := 2 to 13 do a[i] := a[i-1] * i;
  if (n <= 13) and (a[n] < k) then
    begin
      writeln(op, -1);
      exit;
    end;
  for i := 1 to 13 do if a[i] > k then
    begin
      pos := i;
      luu := pos;
      break;
    end;
  fillchar(vis, sizeof(vis), true);
  count := 0;
  gan := 0;
  a[0] := 1;
  while (pos > 0) and (k > 0) do
    begin
      dec(pos);
      inc(gan);
      if k mod a[pos] = 0 then u := k div a[pos]
      else u := k div a[pos] + 1;
      k := k - (u-1) * a[pos];
      vj := 0;
      for j := 1 to 13 do if vis[j] then
        begin
          inc(vj);
          if vj = u then
            break;
        end;
      vis[j] := false;
      cs[j] := gan;
    end;
  res := 0;
  xx := n-luu;
  solve;
  for i := n-luu+1 to n do
    if check(i) and check(cs[i-(n-luu)] + n-luu) then inc(res);
  writeln(op, res);
end;

begin
  assign(ip, fi); reset(ip);
  assign(op, fo); rewrite(op);
  process;
  close(ip);
  close(op);
end.

Program C_LuckyPermutation;
Const MaxN=1024;
Var n,m,k,count:Longint;
    gt:array[0..13] of Int64;
    a,d:array[1..13] of Longint;
    arr:array[0..MaxN] of Int64;

Procedure AddResult(i:Longint);
Var j:Longint;
Begin
  Inc(m);
  arr[m]:=0;
  For j:=1 to i do arr[m]:=arr[m]*10+d[j];
End;

Procedure Try(i:Longint);
Var j:Longint;
Begin
  If i>9 then Exit;
  d[i]:=4;
  AddResult(i);
  Try(i+1);
  d[i]:=7;
  AddResult(i);
  Try(i+1);
End;

Procedure Swap(Var a,b:Int64);
Var t:Int64;
Begin t:=a; a:=b; b:=t End;

Procedure QuickSort(L,r:Longint);
Var i,j:Longint;
    k:Int64;
Begin
  If l>=r then exit;
  i:=l; j:=r;
  k:=arr[random(r-l+1)+l];
  Repeat
    While arr[i]<k do INc(i);
    While arr[j]>k do Dec(j);
    If i<=j then
      Begin
        If i<j then Swap(arr[i],arr[j]);
        Inc(i); Dec(j);
      End;
  Until i>j;
  QuickSort(l,j); QUickSort(i,r)
End;

Procedure Init;
Var i:Longint;
Begin
  Try(1);
  QuickSort(1,m);
  Inc(m); arr[m]:=4444444444; arr[0]:=-MaxLongint;
  gt[0]:=1;
  For i:=1 to 13 do gt[i]:=gt[i-1]*i;
End;

Procedure Input;
Var f:Text;
Begin
  Assign(f,''); Reset(f);
  Readln(f,n,k);
  Close(f)
End;

Function IsLuckyNum(v:Int64):Boolean;
Var k:Longint;
Begin
  While v<>0 do
    Begin
      k:=v mod 10;
      If (k<>4) and (k<>7) then Exit(False);
      v:=v div 10;
    End;
  Exit(True);
End;

Procedure Delete(t:Longint);
Var j:Longint;
Begin
  For j:=t to count-1 do a[j]:=a[j+1];
  Dec(count);
End;

Procedure Solve;
Var i,res,j,p,v:Longint;
Begin
  If (n<=13) and (k>gt[n]) then
    Begin
      Writeln(-1);
      Exit;
    End;
  For i:=m downto 0 do If arr[i]<(n-12) then Break;
  res:=i;
  i:=n-12; If i<1 then i:=1;
    Begin
        For j:=i to n do a[j-i+1]:=j;
        count:=n-i+1;
        For j:=1 to count do
          Begin
            For p:=1 to count do
              If k-1<p*gt[(n-i+1)-j] then Break;
            Dec(k,(p-1)*gt[(n-i+1)-j]);
            v:=a[p]; Delete(p);
            If IsLuckyNum(v) and IsLuckyNum(i+j-1) then Inc(res);
          End;
        Writeln(res);
        Exit;
      End;
End;

BEGIN
  Input;
  Init;
  Solve;
END.

var otv,n,m,i,j,k,count,answer,num,cnt,q,t,numb,number,qans:longint;
    a:array[0..10001] of int64;
    b,c:array[0..20] of longint;
    fact:longint;
procedure rec(q:int64);
var i:longint;
begin
 if q<=1000000000 then
  begin
   inc(count);
   a[count]:=q;
  end else
 exit;
 rec(q*10+4);
 rec(q*10+7);
end;

function factor(ver:longint):longint;
var i,ans:longint;
begin
 ans:=1;
 for i:= 1 to ver do
  ans:=ans*i;
 factor:=ans;
end;

function fun(lik:longint):boolean;
var i:longint;
begin
 for i:= 1 to count do
  if a[i]=lik then
   begin
    fun:=true;
    exit;
   end;
 fun:=false;
end;

begin
 count:=0;
 readln(n,m);
 rec(0);
 answer:=0;
 fact:=1;
 num:=0;
 for i:= 1 to n do
  begin
   fact:=fact*i;
   if fact>=m  then
    begin
     num:=i;
     break;
    end;
   if num<>0 then break;
  end;
  if num=0 then begin writeln(-1); halt; end;
  cnt:=0;
  q:=n-num+1;
  for i:= 1 to num do
   begin
    inc(cnt);
    c[cnt]:=q+i-1;
   end;
  qans:=0;
  k:=m;
  for i:= 1 to cnt do
   begin
    t:=factor(num-1);
    if k mod t = 0 then number:=k div t else
    number:=k div t + 1;
    k:= k mod t;
    if k=0 then k:=t;
    inc(qans);
    b[qans]:=c[number];
    for j:= number to num-1 do
     c[j]:=c[j+1];
    c[num]:=0;
    dec(num);
   end;
  otv:=0;
  for i:= 1 to count do
   if a[i]<q then inc(otv);
  for i:= 1 to cnt do
   if fun(b[i]) and fun(q+i-1) then
   inc(otv);
   writeln(otv-1);
end.

var l,j,n,k,i:longint;
ans,s:int64;
w,q,fa:array[0..15]of int64;
num:array[0..15]of longint;
u:array[0..15]of boolean;

function good(x:int64):boolean;
 begin
  while x>0 do
    begin
     if (x mod 10<>4)and(x mod 10<>7) then
       begin
        good:=false;
        exit;
       end;
     x:=x div 10;
    end;
  good:=true;
 end;

procedure gen(v:int64);
 begin
  if v>n then exit;

  if v<=n-j then ans:=ans+1;

  gen(v*10+4);
  gen(v*10+7);
 end;

 begin
  read(n,k);
  s:=1;
  for i:=1 to n do
    begin
     s:=s*i;
     if s>=k then
       begin
        j:=i;
        break;
       end;
    end;

  if s<k then
    begin
     writeln(-1);
     halt(0);
    end;

  gen(4);
  gen(7);

  fa[0]:=1;
  for i:=1 to 15 do fa[i]:=fa[i-1]*i;

  for i:=1 to j do
   begin
    q[i]:=n-j+i;
   end;

  fillchar(u,sizeof(u),true);

  for i:=1 to j do
    begin
     for l:=1 to j do
       if u[l] then
         begin
          if fa[j-i]>=k then
            begin
             num[i]:=l;
             u[l]:=false;
             break;
            end;
          k:=k-fa[j-i];
         end;
    end;
  for i:=1 to j do
    begin
     w[i]:=q[num[i]];
     if good(n-j+i) and good(w[i]) then ans:=ans+1;
    end;

  writeln(ans);
 end.

Program Lucky_Permutation;
var n,k,i,j,z,s,ans:longint;
    p:array[0..20]of int64;
    used:array[1..20]of boolean;
//========================================================================
function lucky(x:longint):boolean;
begin
  while x>0 do
    begin
      if (x mod 10<>4)and(x mod 10<>7) then exit(false);
      x:=x div 10;
    end;
  exit(true);
end;
//========================================================================
procedure Create(x:int64);
begin
  if x>s then exit;
  inc(ans);
  Create(x*10+4);Create(x*10+7);
end;
//========================================================================
begin
  readln(n,k);
  p[0]:=1;
  for i:=1 to 20 do p[i]:=p[i-1]*i;
  if (n<=20)and(p[n]<k) then
    begin
      writeln(-1);exit;
    end;
  for i:=1 to 20 do
    if p[i]>=k then break;
  s:=i;
  for i:=s-1 downto 0 do
    begin
      for j:=1 to s do
        begin
          if k<=p[i] then break;
          k:=k-p[i];
        end;
      z:=0;
      while j>0 do
        begin
          inc(z);
          if not used[z] then dec(j);
        end;
      used[z]:=true;
      if lucky(n-i) and lucky(n-s+z) then inc(ans);
    end;
  s:=n-s;
  Create(4);Create(7);
  writeln(ans);
end.

{$mode objfpc}
const
        fi='';
        fo='';
var
        a:array[1..2]of integer=(4,7);
        luckynum:array[0..3000]of int64;
        x,CT:Array[0..13]of integer;
        avail:array[0..13]of boolean;
        c:array[0..13]of int64;
        m,k:int64;
        n:integer;
        res:int64;
        f,g:Text;
        flag:boolean;

procedure       attemp(i:integer;s:int64);
var     j:integer;
begin
        for j:= 1 to 2 do
                begin
                    s:=s*10+a[j];
                    if i=n then begin inc(m);luckynum[m]:=s; end else attemp(i+1,s);
                    s:=s div 10;
                end;
end;

function        find(x:int64):boolean;
var     l,h:integer;
        mid:integer;
begin
 l:=1;h:=m;
 while l<=h do
        begin
            mid:=(l+h) div 2;
            if luckynum[mid]=x then exit(true);
            if luckynum[mid]<x then l:=mid+1 else h:=mid-1;
        end;
  result:=false;
end;

procedure       solve;
var     i,j:integer;
        kt:integer;
begin
        m:=0;res:=0;
        for n:=1 to 10 do attemp(1,0);
        readln(f,n,k);
        kt:=0; flag:=false;
        if n>13 then
                begin
                   kt:=n-13;
                   For j:=1 to m do
                        if luckynum[j]<=kt then inc(res) else break;
                   n:=13;
                   flag:=true;
                end;
       For i:=1 to n do ct[i]:=kt+i;
       c[0]:=1;
       for i:=1 to n do c[i]:=c[i-1]*i;
       flag:=flag or (c[n]>=k);
       fillchar(avail,sizeof(avail),true);
       for i:=1 to n do
           begin
             for j:=1 to n do
             if avail[j] then
                     if (k>c[n-i]) then dec(k,c[n-i]) else break;
             x[i]:=j;avail[j]:=false;
          end;
       For i:=1 to n do
        begin
            if find(ct[x[i]]) and (find(i+kt)) then inc(res);
        end;
end;

procedure       openf;
begin
    assign(f,fi);reset(f);
    assign(g,fo);rewrite(g);
end;

procedure       closef;
begin
   close(f);close(g);
end;

procedure       print;
begin
  if flag then writeln(g,res) else writeln(g,'-1');
end;

begin
     openf;
     solve;
     print;
     closef;
end.

var b:array[0..10] of longint;
    a:array[0..100000] of longint;
    i,o,s,j,n,k,c,e,sum,sc:longint;
    fact:array[0..15] of int64;
    use,ans:array[0..20] of longint;

function lucky(s:longint):boolean;
  begin
    while s>0 do
      begin
        if (s mod 10<>4) and (s mod 10<>7) then exit(false);
        s:=s div 10;
      end;
    exit(true);
  end;

begin
  o:=0;
  for i:=1 to 9 do
    begin
      fillchar(b,sizeof(b),0);
      while b[0]=0 do
        begin
          s:=0;
          for j:=1 to i do
            if b[j]=0 then s:=s*10+4 else s:=s*10+7;
          inc(o);
          a[o]:=s;
          j:=i;
          while b[j]=1 do
            begin
              b[j]:=0;
              dec(j);
            end;
          inc(b[j]);
        end;
    end;
  //for i:=1 to o do writeln(a[i]);
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=int64(fact[i-1])*i;
  if n<=15 then
    begin
      if k>fact[n] then
        begin
          writeln(-1);
          halt;
        end;
      dec(k);
      fillchar(use,sizeof(use),0);
      for i:=1 to n do
        begin
          c:=k div fact[n-i]+1;
          k:=k mod fact[n-i];
          e:=0;
          for j:=1 to n do
            if use[j]=0 then
              begin
                inc(e);
                if e=c then
                  begin
                    ans[i]:=j;
                    use[j]:=1;
                    break;
                  end;
              end;
        end;
      //for i:=1 to n do write(ans[i],' ');writeln;
      sum:=0;
      for i:=1 to n do
        if lucky(i) and lucky(ans[i]) then inc(sum);
      writeln(sum);
    end
  else
    begin
      sc:=n-15;
      n:=15;
      dec(k);
      fillchar(use,sizeof(use),0);
      for i:=1 to n do
        begin
          c:=k div fact[n-i]+1;
          k:=k mod fact[n-i];
          e:=0;
          for j:=1 to n do
            if use[j]=0 then
              begin
                inc(e);
                if e=c then
                  begin
                    ans[i]:=j;
                    use[j]:=1;
                    break;
                  end;
              end;
        end;
      for i:=1 to n do ans[i]:=ans[i]+sc;
      //for i:=1 to sc do write(i,' ');for i:=1 to n do write(ans[i],' ');writeln;
      sum:=0;
      for i:=1 to o do
        if a[i]<=sc then inc(sum);
      for i:=1 to n do
        if lucky(i+sc) and lucky(ans[i]) then inc(sum);
      writeln(sum);
    end;
end.

uses math;
const
      oo=high(longint);
      _oo=high(int64);
      roo=1e30;
      dx:array[0..7] of longint=(-1,0,1,0,-1,1,1,-1);
      dy:array[0..7] of longint=(0,1,0,-1,1,1,-1,-1);
      hs=13;
type point=record x,y:longint; end;
     rpoint=record x,y:double; end;
var f,g:text;
    fi,fo:string;
    a:array[0..111111] of int64;
    gt,num:array[0..33] of int64;
    fr:array[0..33] of boolean;
    nluc,n,i,j,last,nn,ans:longint;
    be,k,nho:int64;
procedure closefile; begin close(g); close(F); end;
//-----------------
procedure sort(l,r:longint);
var i,j:longint;
    m,tmp:int64;
begin
        if l>=r then exit;
        i:=l; j:=r; m:=a[l+random(r-l+1)];
        repeat
               while a[i]<m do inc(i);
               while a[j]>m do dec(j);
               if i<=j then begin
                   tmp:=a[i]; a[i]:=a[j]; a[j]:=tmp;
                   inc(i);
                   dec(j);
               end;
        until i>J;
        sort(i,r);
        sort(l,j);
end;
procedure gen;
var i,j,k:Longint;
begin

                for i:=1 to 11 do
                 for j:=0 to 1<<i-1 do begin
                     inc(nluc);
                     for k:=0 to i-1 do
                      if (j>>k) and 1=0 then a[nluc]:=a[nluc]*10+4
                      else a[nluc]:=a[nluc]*10+7;
                 end;
                sort(1,nluc);
end;
//---------------------
function isluck(u:longint):boolean;
var s:string;
    i:longint;
begin
        str(u,s);
        for i:=1 to length(s) do
         if (s[i]<>'4') and (s[i]<>'7') then exit(false);
        isluck:=true;
end;
begin
        gen;

        randomize;
       // {$IFNDEF ONLINE_JUDGE} fi := 'i.inp'; fo := ''; {$ENDIF}
        assign(f,fi); reset(f);
        assign(g,fo); rewrite(g);
                readln(f,n,k);
                gt[0]:=1;
                for i:=1 to 12 do gt[i]:=gt[i-1]*i;
                gt[13]:=oo;
                nn:=min(n,hs);
                if n>hs then be:=n-hs
                else be:=0;
                ans:=0;
                if n>hs then begin
                 for i:=1 to nluc do
                  if a[i]>n-hs then break;
                 ans:=i-1;
                end;
                if (n<hs) and (k>gt[n]) then begin
                    writeln(g,-1);
                    closefile;
                    halt;
                end;
                //
                    for i:=1 to nn do fr[i]:=true;
                    for i:=1 to nn-1 do begin
                      nho:=0; last:=0;
                      for j:=1 to nn do
                       if (nho*gt[nn-i]>=k) then break
                       else if fr[j] then begin
                           inc(nho);
                           last:=j;
                       end;

                      dec(k,(nho-1)*gt[nn-i]);
                      num[i]:=last;
                      fr[last]:=false;
                    end;
                    for i:=1 to nn do
                     if fr[i] then num[nn]:=i;
                    for i:=1 to nn do
                     if isluck(i+be) and isluck(num[i]+be) then inc(ans);
                //
                writeln(g,ans);
        closefile;
end.

{$APPTYPE CONSOLE}
{$maxstacksize 2000000}
var
 ans,nb,l,q,j,add,n,k,i:integer;
 fc:int64;
 a:array[1..15] of integer;
 us:array[1..15] of boolean;

 Function lucky(n:integer):boolean;
 var
  b:boolean;
 begin
  b:=true;

  while (n>0) and (b) do
  begin
   b:=(n mod 10=7) or (n mod 10=4);
   n:=n div 10;
  end;

  lucky:=b;
 end;

 Procedure gen(cur:int64);
  begin
    If cur>add then exit;
    If cur>0 then inc(ans);
    gen(cur*10+4);
    gen(cur*10+7);
  end;

begin
{ reset(input,'Input.txt');
 rewrite(output,'Output.txt'); }
 readln(n,k);

 fc:=1;
 i:=1;

 while (fc<k) and (i<n) do
 begin
  inc(i);
  fc:=fc*i;
 end;

 If fc<k then writeln(-1) else
 begin
  add:=n-i;
  Fillchar(us,sizeof(us),0);

  For j:=1 to i do
  begin
   fc:=fc div (i-j+1);
   q:=k div fc;
   If k mod fc=0 then dec(q);
   inc(q);
   nb:=0;
   For l:=1 to i do If not us[l] then
   begin
    inc(nb);
    If nb=q then
    begin
     us[l]:=true;
     a[j]:=l;
     break;
    end;
   end;
   k:=k-(q-1)*fc;
  end;

  For j:=1 to i do a[j]:=a[j]+add;
  ans:=0;

  For j:=1 to i do If (lucky(add+j)) and (lucky(a[j])) then inc(ans);

  gen(0);

  writeln(ans);
 end;

end.

program task;

{$APPTYPE CONSOLE}
{$O+}

uses
  Math,
  SysUtils;

var n,k:int64;
    res:int64;
    cur,i,curi,ppc:int64;
    l:int64;
    used:array[1..13]of boolean; // numbers from(n-12)to n

function gen(x:int64):int64;
var n:longint;
    m,res:int64;
begin
    m:=x;
    n:=0;
    while(m<>0)and (m mod 10=7)do begin
        n:=n+1;
        m := m div 10;
    end;
    if m=0 then begin
        res:=0;
        n:=n+1;
        while (n<>0) do begin
            res:=res*10+4;
            n:=n-1;
        end;
    end
    else begin
        res:=(m div 10)*10 +7;
        while (n<>0) do begin
            res:=res*10+4;
            n:=n-1;
        end;
    end;
    gen:=res;
end;

function lucky(u:int64):boolean;
var m:int64;
    res:boolean;
begin
    res:=true;
    m:=u;
    while m<>0 do begin
        res:=res and((m mod 10 =4)or(m mod 10=7));
        m:=m div 10;
    end;
    lucky:=res;
end;

function nn(u:int64):longint;
var res:longint;
    cur:int64;
begin
    cur:=4;
    res:=0;
    while (cur<=u) do begin
        inc(res);
        cur:=gen(cur);
    end;
    nn:=res;
end;

function fac(x:int64):int64;
var i,res:int64;
begin
    i:=1;
    res:=1;
    while(i<=x) do begin
        res:=res*i;
        i:=i+1;
    end;
    fac:=res;
end;

begin
    readln(n,k);
    res:=0;
    fillchar(used,sizeof(used),false);
    if n>13 then begin
        res:=res+nn(n-13);
        curi:=n-12;
        l:=1;
    end
    else begin
        curi:=1;
        l:=13-n+1;
        cur:=fac(n);
        if k>cur then begin
            writeln('-1');
            halt(0);
        end;
    end;
    while (curi<=n) do begin
        cur:=fac(n-curi);
        i:=l;
        while (used[i]) do i:=i+1;;
        ppc:=cur;
        while (ppc<k) do begin
            i:=i+1;
            while (used[i]) do i:=i+1;
            ppc:=ppc+cur;
        end;
        used[i]:=true;
        if lucky(curi)and(lucky(n+i-13)) then res:=res+1;
        curi:=curi+1;
        k:=k-(ppc-cur);
    end;
    writeln(res);
    halt(0);
end.

Uses SysUtils;
Var
   r:Array[1..10000] of Int64;
   a,b,f:Array[0..30] of Int64;
   n,k,t,w,m,kol,p,v,n1:Int64;
   i,j,l,f1,f2:Integer;
Function Max(x,y:Int64):Int64;
Begin
   If x>y Then Max:=x
          Else Max:=y;
End;
Procedure Get(x:Int64);
Begin
   If x>1000000000 Then Exit;
   i:=i+1;
   r[i]:=x;
   Get(10*x+4);
   Get(10*x+7);
End;
Begin
   Read(n,k);
   f[0]:=1;
   For i:=1 To 14 Do f[i]:=i*f[i-1];
   If n<14 Then
      If k>f[n] Then Begin
         Write(-1);
         Halt;
      End;
   i:=0;
   Get(4);
   Get(7);
   m:=i;
   For i:=1 To m-1 Do
      For j:=i+1 To m Do
         If r[i]>r[j] Then Begin
            w:=r[i];
            r[i]:=r[j];
            r[j]:=w;
         End;
   kol:=0;
   t:=Max(1,n-12);
   j:=1;
   n1:=n;
   For i:=t To n Do Begin
      b[j]:=i;
      j:=j+1;
   End;
   For i:=1 To m Do Begin
      If r[i]>=t Then Break;
      kol:=kol+1;
   End;
   If n>12 Then n:=13;
   p:=n;
   i:=0;
   While True Do Begin
      i:=i+1;
      v:=k div f[n-1];
      If k mod f[n-1]<>0 Then v:=v+1;
      a[i]:=b[v];
      j:=1;
      n:=n-1;
      If n=0 Then Break;
      For l:=1 To n Do Begin
         If b[l]=a[i] Then j:=j+1;
         b[l]:=b[j];
         j:=j+1;
      End;
      k:=k mod f[n];
      If k=0 Then k:=f[n];
   End;
   l:=Max(1,n1-12);
   For i:=1 To p Do Begin
      f1:=0;
      f2:=0;
      For j:=1 To m Do Begin
         If r[j]=l Then f1:=1;
         If r[j]=a[i] Then f2:=1;
      End;
      If (f1=1) and (f2=1) Then kol:=kol+1;
      l:=l+1;
   End;
   Write(kol);
End.

{$R+,S+,Q+,I+,O-}
{R-,S-,Q-,I-,O+}
var
  f: array [0..99] of int64;
  n,k,i,j,m,x,y,ans: longint;
  was: array [0..99] of boolean;

procedure rec(w:int64);
begin
  if w <= n-m then
  begin
    inc(ans);
    rec(w*10+4);
    rec(w*10+7);
  end;
end;

function lucky(t:int64):boolean;
begin
  while t > 0 do
  begin
    if (t mod 10 <> 4) and (t mod 10 <> 7) then
    begin
      lucky:=False;
      exit;
    end;
    t:=t div 10;
  end;
  lucky:=True;
end;

begin
//  assign(input,'in'); reset(input);
//  assign(output,'out'); rewrite(output);
  f[0]:=1;
  for i:=1 to 19 do f[i]:=f[i-1]*i;
  read(n,k);
  m:=0;
  for i:=1 to n do
    if f[i] >= k then
    begin
      m:=i;
      break;
    end;
  if m = 0 then
  begin
    writeln('-1');
    halt;
  end;
  ans:=0;
  rec(4); rec(7);
  fillchar(was,sizeof(was),False);
  for i:=1 to m do
  begin
    x:=0; y:=1;
    while k > f[m-i] do
    begin
      k:=k-f[m-i];
      inc(y);
    end;
    for j:=1 to y do
    begin
      inc(x);
      while was[x] do inc(x);
    end;
    was[x]:=True;
    if lucky(n-m+i) and lucky(n-m+x) then inc(ans);
  end;
  writeln(ans);
  close(input);
  close(output);
end.

{$APPTYPE CONSOLE}
{$O-,Q-,R-,S+}
uses
  SysUtils, Math;
var
  a, mas, pf, good, good2 : array [1..20]of Int64;
  i, j, k, n : int64;
  q, ans, lg, ll, l : longint;
  s : string;
function next(n : int64) : int64;
var
  i, j : LongInt;
begin
  s := '';
  while n > 0 do
    begin
      s := chr(n mod 10 + 48) + s;
      n := n div 10;
    end;
  i := Length(s);
  while (i > 0) and (s[i] = '7') do
    Dec(i);
  if i = 0 then
    begin
      for i := 1 to Length(s) do
        s[i] := '4';
      result := strtoint64(s + '4');
    end
  else
    begin
      s[i] := '7';
      for j := i + 1 to Length(s) do
        s[j] := '4';
      result := strtoint64(s);
    end;
end;
function fack(n : int64) : int64;
var
  i : longint;
  j : Int64;
begin
  if n > 13 then
    n := 13;
  result := 1;
  for i := 2 to n do
    begin
      j := i;
      result := result * j;
    end;
end;
begin
//  reset(input, 'input.txt');
//  rewrite(output, 'output.txt');
  Readln(n, k);
  ans := 0;
  if fack(n) < k then
    begin
      writeln(-1);
      exit;
    end;
  if n > 13 then begin
  q := n - 13;
  ans := 0;
  i := 4;
    while i <= q do
    begin
      Inc(ans);
      i := Next(i);
    end;
  if i > n then
    begin
      writeln(ans);
      exit;
    end;
   good[1] := 13 - (n - i);
   pf[1] := i;
   if next(i) <= n then
     begin
       good[2] := 13 - (n - next(i));
       pf[2] := next(i);
       lg := 2;
       good2[1] := 13 - (n - next(i));
       good2[2] := 13 - (n - i);
     end
   else
     lg := 1;
   for q := n - 12 to n do
     a[q - (n - 12) + 1] := q;
   n := 13;
  end
  else
    begin
      for q := 1 to n do
        a[q] := q;
      if n > 6 then
        begin
          lg := 2;
          good[2] := 7;
          pf[2] := 7;
          good[1] := 4;
          pf[1] := 4;
          good2[2] := 4;
          good2[1] := 7;
        end
      else
        if n > 3 then
          begin
            lg := 1;
            good[1] := 4;
            pf[1] := 4;
          end
        else
          begin
            Writeln(0);
            Exit;
          end;
    end;
  ll := n;
  Dec(k);
  for q := n - 1 downto 1 do
    begin
      j := q;
      i := 0;
      while i * fack(j) <= k do
        Inc(i);
      Dec(i);
      mas[n - q] := a[i + 1];
      k := k - i * fack(j);
      for l := i + 1 to ll do
        a[l] := a[l + 1];
      Dec(ll);
    end;
  mas[n] := a[1];
  for l := 1 to lg do
    if (mas[good[l]] = pf[l]) or (mas[good2[l]] = pf[l]) then
      Inc(ans);
  Writeln(ans);
end.

const maxn = 1000;
const inf : int64 = 1000000000000000;

var
  used,fac:array[0..maxn] of int64;
  l,cc,z,ans,o_O,i,n:longint;
  k,kth:int64;

function lucky(const k:longint):longint;
var
  s:string;
  i:longint;
begin
  str(k, s);
  lucky:=0;
  for i:=1 to length(s) do if (s[i] <> '4')and(s[i] <> '7') then exit;
  lucky:=1;
end;

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

procedure cnt_before(const k, ub:int64);
begin
  if k<=ub then inc(ans) else exit;
  cnt_before(k*10+4, ub);
  cnt_before(k*10+7, ub);
end;

begin
//  reset(input, 'in.txt');
//  rewrite(output, 'out.txt');
  read(n, k);
  fac[0]:=1;
  for i:=1 to 100 do
  begin
    fac[i]:=fac[i-1]*i;
    if fac[i]>inf then fac[i]:=inf;
  end;
  if (n<20)and(fac[n]<k) then
  begin
    writeln(-1);
    close(output);
    halt;
  end;
  if n>20 then
  begin
    cnt_before(4, n-20);
    cnt_before(7, n-20);
  end;
  for o_O:=max(1, n-20+1) to n do
  begin
    z:=0;
    kth:=k div fac[n-o_O]+ord(k mod fac[n-o_O]>0);
    inc(kth, ord(kth = 0));
    for i:=max(1, n-20+1) to n do if used[i-max(1, n-20+1)] = 0 then
    begin
      inc(z);
      if z = kth then
      begin
        cc:=i;
        break;
      end;
    end;
    if (lucky(cc) = 1)and(lucky(o_O) = 1) then inc(ans);
    used[cc-max(1, n-20+1)]:=1;
    l:=n-o_O;
    dec(k, fac[l]*(kth-1));
  end;
  writeln(ans);
  close(output);
end.

program Project5;

{$APPTYPE CONSOLE}

var
  n, k, x, ans, p, d: int64;
  i, j, z, t: longint;
  a: array[1..10000] of int64;
  b: array[1..20] of longint;
  mas: array[1..20] of int64;

procedure gen47(k, x, n: longint);
begin
  if k > n then begin
    inc(t);
    a[t] := x;
  end else begin
    x := x * 10 + 4;
    gen47(k + 1, x, n);
    x := x div 10;
    x := x * 10 + 7;
    gen47(k + 1, x, n);
  end;
end;

function fact(x: int64): int64;

var
  ans: int64;
  i: longint;

begin
  if x > 13 then
    result := k + 1
  else if x = 0 then
    result := 1
  else begin
    ans := 1;
    for i := 2 to x do
      ans := ans * i;
    result := ans;
  end;
end;

function f(x: longint): longint;

var
  i, ans: longint;

begin
  i := 1;
  while a[i] <= x do
    inc(i);
  result := i - 1;
end;

function sch(x: int64): boolean;

var i: longint;

begin
  for i := 1 to t do
    if a[i] = x then begin
      result := true;
      exit;
    end;
  result := false;
end;

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

  read(n, k);
  ans := 0;
  if fact(n) < k then
    write(-1)
  else begin

    for i := 1 to 15 do
      b[i] := 0;

    t := 0;
    for i := 1 to 9 do
      gen47(1, 0, i);
    inc(t);
    a[t] := 4444444444;

    i := 1;

    if n > 12 then
      i := n - 12;

    d := fact(n - i);
    while d > k do begin
      inc(i);
      d := d div (n - i + 1);
    end;
    ans := ans + f(i - 1);

    x := fact(n - i);
    for j := i to n do begin

      p := k div x;
      if k mod x = 0 then
        dec(p);
      k := k - p * x;
      inc(p);

      if n - j = 0 then
        x := 1
      else
        x := x div (n - j);
      if x = 0 then
        x := 1;

      z := 1;
      while p > 0 do begin
        if b[z] = 0 then
          dec(p);
        inc(z);
      end;
      dec(z);
      b[z] := 1;

      mas[j - i + 1] := z + i - 1;

    end;

    for j := i to n do
      if sch(j) and sch(mas[j - i + 1]) then
        inc(ans);

    write(ans);
  end;

  closefile(input);
  closefile(output);
end.

{$R+,I+,S+,O+,O-}
Uses Math;
type
	int = longint;
	bool = boolean;
const
	inf = maxint;
var
	n, i, ok1, ok2, u, len, ans, sz, j, m, k, sum : int;
	p, a, b, c, mult : array [0..2000] of int;
	was : array [0..20] of bool;

procedure findnumbers;
begin
	p[0] := 1; sz := 0;
	for i := 1 to 9 do
		p[i] := p[i-1] * 10;

  for u := 1 to 9 do begin
  	len := 1 shl u - 1;
  	for i := 0 to len do begin
	  	for j := 0 to u-1 do
		  	if (i shr j and 1 = 1) then
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 7
			  else
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 4;
	  end;
    sz := sz + len + 1;
  end;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	findnumbers;
	read(n, k);
	m := min(13, n);
	sum := 0;

	for i := n-m+1 to n do
		c[i-n+m] := i;

	ans := 0;
	mult[0] := 1;

	for i := 1 to m-1 do
		mult[i] := mult[i-1] * i;

	for i := 1 to m do begin
		for j := 1 to m do
			if (not was[j]) then begin
				sum	:= sum + mult[m-i];
				if (sum >= k) then begin
					a[i] := c[j];
					was[j] := true;

					break;
				end;
			end;
    if (a[i] = 0) then begin
      write(-1);
			halt;
    end;
		sum := sum - mult[m-i];
	end;

	for i := 1 to sz do
		if (b[i] < n-m+1) then inc(ans);

	for i := 1 to m do begin
    ok1 := 0; ok2 := 0;
		for j := 1 to sz do begin
			if (a[i] = b[j]) then ok1 := 1;
      if (i+n-m = b[j]) then ok2 := 1;
    end;
    if (ok1 + ok2 = 2) then inc(ans);
  end;

	write(ans);
end.

{$R+}{$Q+}
Var fac:array [0..15] of int64;
m:array [1..100] of longint;
a:array [1..15] of longint;
used:array [1..15]of boolean;
e,z,kol,i,n,j,k:longint;
rez,zz:int64;
function proverka(x:int64):boolean;
begin
  while x<>0 do
  begin
    if (x mod 10<>4)and(x mod 10<>7)
    then begin proverka:=false; exit; end;
    x:=x div 10;
  end;
  proverka:=true;
end;
begin
  //Assign(input,'input.txt'); reset(input);
  //Assign(output,'output.txt'); rewrite(output);
  read(n,k);
  fac[0]:=1;
  for i:=1 to 15 do
  fac[i]:=fac[i-1]*i;
  if n<=15
  then begin
        if fac[n]<k
        then begin
              writeln(-1);
              halt(0);
             end;
       end;
  kol:=0;
  if n>15
  then begin
         z:=1;
         while 1=1 do
         begin
           zz:=1;
           rez:=0;
           for i:=1 to z do
           begin
             if m[i]=0
             then rez:=rez+zz*4
             else rez:=rez+zz*7;
             zz:=zz*10;
           end;
           if rez<=n-15
           then inc(kol)
           else break;
           inc(m[1]);
           for i:=1 to z do
           if m[i]=2
           then begin
                 inc(m[i+1]);
                 m[i]:=0;
                end;
           if m[z+1]=1
           then begin
                 inc(z);
                 fillchar(m,sizeof(m),0);
                end;
         end;
         e:=15;
       end
  else e:=n;
  dec(k);
  for i:=1 to e do
  begin
    z:=1;
    while fac[e-i]<=k do
    begin
      k:=k-fac[e-i];
      inc(z);
    end;
    for j:=1 to e do
    if not used[j]
    then begin
          dec(z);
          if z=0
          then begin
                used[j]:=true;
                a[i]:=j;
                break;
               end;
         end;
  end;
  for i:=1 to e do
  if proverka(n-(e-i))and(proverka(n-e+a[i]))
  then inc(kol);
  writeln(kol);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
        sum, i, p, v, ans, len, l, u, j, q, x: longint;
        kol, k, n, t, cur, kl: int64;
        b, f: array [0..20] of int64;
        was: array [0..20] of boolean;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
        i: longint;

begin
        if p > len then begin
                inc(l); a[l] := x;
                exit;
        end;
        for i := 0 to 1 do
                if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
        lucky := false;
        while (x > 0) do begin
                if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
                x := x div 10;
        end;
        lucky := true;
end;

begin
        {$ifndef online_judge}
        reset(input, 'a.in');
        rewrite(output, 'a.out');
        {$endif}
        read(n, k); l := 0;
        for len := 1 to 9 do
                go(1, 0);
        ans := 0;
        for i := 1 to l do
                if (a[i] <= n - 13) then inc(ans);
        u := min(13, n);

        f[0] := 1; for i := 1 to 13 do f[i] := f[i - 1] * i;
        if f[u] < k then begin
                write(-1);
                halt;
        end;

        sum := 0;
        for i := 1 to u do begin
                for j := 1 to u do
                        if not was[j] then begin
                                sum := sum + f[u - i];
                                if sum >= k then begin
                                        was[j] := true;
                                        b[i] := j;
                                        break;
                                end;
                        end;
                sum := sum - f[u - i];
        end;

        for i := 1 to u do
                if (lucky(n - u + i)) and (lucky(n - u + b[i])) then inc(ans);
        write(ans);
end.

{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q+,R+,S+,T-,U-,V+,W-,X+,Y+,Z1}
//{$A8,B-,C+,D-,E-,F-,G+,H+,I-,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}

program ProblemE;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Math;

const
  inname = 'input.txt';
  outname = 'output.txt';
  maxn = 0;
  maxm = 0;
  inf = maxlongint div 2;
  eps = 0;

type
  int = longint;
  bool = boolean;
  real = extended;

var
  n, ans, k: int64;
  a, b: array[0..14] of int64;
  u: array[0..14] of bool;

procedure gen(t: int64);
begin
  if t <= n - 13 then
    if (t <> 0) then
      inc(ans)
    else
  else
    exit;

  gen(t*10 + 4);
  gen(t*10 + 7);
end;

procedure go(c, t, k: int64);
begin
  if t < 1 then
    exit;

  b[c] := (k - 1) div a[t - 1] + 1;
  go(c + 1, t - 1, k - (b[c] - 1)*a[t-1]);
end;

function isHappy(t: int): bool;
begin
  result := false;
  while t > 0 do begin
    if (t mod 10 <> 4) and (t mod 10 <> 7) then
      exit;
    t := t div 10;
  end;
  result := true;
end;

procedure run;
var
  i, j, d: int;
begin
  a[0] := 1;
  for i := 1 to 14 do
    a[i] := a[i-1]*i;

  read(n, k);

  if (n < 14) and (a[n] < k) then begin
    write(-1);
    exit;
  end;

  ans := 0;

  gen(0);

  go(1, min(13, n), k);

  fillchar(u, sizeof(u), false);
  for i := 1 to min(13, n) do begin
    d := b[i];

    for j := 1 to 14 do
      if not u[j] then begin
        dec(d);
        if d = 0 then begin
          b[i] := j;
          break;
        end;
      end;

    u[b[i]] := true;
  end;

  for i := 1 to min(13, n) do
    if isHappy(n - min(13, n) + i) then
      if isHappy(n - min(13, n) + b[i]) then
        inc(ans);

  write(ans);
end;

procedure openfiles;
begin
  assign(input, inname);
  assign(output, outname);
  reset(input);
  rewrite(output);
end;

procedure closefiles;
begin
  close(input);
  close(output);
end;

Begin
  //openfiles;
  run;
  //closefiles;
End.

{$r-,q-,s-,i-,o+}
const
  inf=1000000000;
var
  ss,m,i,j,n,k,kt,res:longint;
  t:array[0..500500]of longint;
  q,fact:array[0..500]of longint;
  was:array[0..500500]of boolean;
  procedure gen(x:longint);
    begin
      if (x<>0)then begin
        inc(kt);t[kt]:=x;
      end;
      if (int64(x)*10>inf)then exit;
      gen(x*10+4);
      gen(x*10+7);
    end;
begin
//  assign(input,'input.txt');reset(input);
//  assign(output,'output.txt');rewrite(output);
  read(n,k);
  kt:=0;
  gen(0);
  res:=0;
  for i:=1 to kt do
    if (t[i]<n-12)then inc(res);
  m:=n;
  ss:=1;
  fact[0]:=1;
  if (n>13)then begin
     m:=13;
     ss:=n-12;
     for i:=1 to m do fact[i]:=fact[i-1]*i;
  end else begin
    for i:=1 to n do fact[i]:=fact[i-1]*i;
    if (k>fact[n])then begin
      writeln(-1);
      exit;
    end;
  end;
  fillchar(was,sizeof(was),false);
  for i:=1 to m do begin
    j:=1;
    while (true)do begin
      while (was[j])do inc(j);
      if (k>fact[m-i])then begin
        dec(k,fact[m-i]);
        inc(j);
      end else break;
    end;
    was[j]:=true;
    q[i]:=ss+j-1;
  end;
  for i:=1 to kt do
    if (t[i]>=ss)and(t[i]<=n)then
      for j:=1 to kt do
        if (q[t[i]-ss+1]=t[j])then inc(res);
  writeln(res);
  close(output);close(input);
end.

program Lucky_Permutation;
var
  b:array[0..10] of longint;
  a:array[0..100000] of longint;
  i,o,s,j,n,k,c,e,sum,sc:longint;
  fact:array[0..15] of int64;
  use,ans:array[0..20] of longint;

function lucky(s:longint):boolean;
  begin
    while s>0 do begin
      if (s mod 10<>4) and (s mod 10<>7) then exit(false);
      s:=s div 10;
    end;
    exit(true);
  end;

begin
  o:=0;
  for i:=1 to 9 do begin
    fillchar(b,sizeof(b),0);
    while b[0]=0 do begin
      s:=0;
      for j:=1 to i do
        if b[j]=0 then s:=s*10+4 else s:=s*10+7;
      inc(o);
      a[o]:=s;
      j:=i;
      while b[j]=1 do begin
        b[j]:=0;
        dec(j);
      end;
      inc(b[j]);
    end;
  end;
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=int64(fact[i-1])*i;
  if n<=15 then begin
    if k>fact[n] then begin
      writeln(-1);
      halt;
    end;
    dec(k);
    fillchar(use,sizeof(use),0);
    for i:=1 to n do begin
      c:=k div fact[n-i]+1;
      k:=k mod fact[n-i];
      e:=0;
      for j:=1 to n do
        if use[j]=0 then begin
          inc(e);
          if e=c then begin
            ans[i]:=j;
            use[j]:=1;
            break;
          end;
        end;
    end;
    sum:=0;
    for i:=1 to n do
      if lucky(i) and lucky(ans[i]) then inc(sum);
    writeln(sum);
  end
  else begin
    sc:=n-15;
    n:=15;
    dec(k);
    fillchar(use,sizeof(use),0);
    for i:=1 to n do begin
      c:=k div fact[n-i]+1;
      k:=k mod fact[n-i];
      e:=0;
      for j:=1 to n do
        if use[j]=0 then begin
          inc(e);
          if e=c then begin
            ans[i]:=j;
            use[j]:=1;
            break;
          end;
        end;
    end;
    for i:=1 to n do
      ans[i]:=ans[i]+sc;
    sum:=0;
    for i:=1 to o do
      if a[i]<=sc then inc(sum);
    for i:=1 to n do
      if lucky(i+sc) and lucky(ans[i]) then inc(sum);
    writeln(sum);
  end;
end.

var f1,f2:text;
gt:array[0..100] of int64;
A,B:array[1..100] of longint;
KQ:array[1..100] of longint;
L:array[1..100000] of int64;
scs:longint;
gh:longint;
res:longint;
i,s,n,k,spt,maxso:longint;
Procedure TimSH(n:longint);
var i,dem,j:byte;
    GT:longint;
Begin
        S:=k;
     GT:=1;
     for i:=1 to n-1 do
     GT:=GT*i;
     For i:=1 to n do
     Begin
       B[i]:=i;
       if S mod GT <> 0 then
       Begin
         A[i]:=S Div GT+1;
         S:=S mod GT;
       End
       else
         Begin
           A[i]:=S div GT;
           S:=GT;
         End;
       if n<>i then
       GT:=GT div (n-i);
     ENd;
     For i:=1 to n do
     Begin
       dem:=0;
       For j:=1 to n do
       Begin
         if (B[j]<>0) then
         Inc(dem);
         if dem = A[i] then break;
       End;
       KQ[i]:=B[j];
       B[j]:=0;
     End;
End;

Procedure Gen(vt:longint;so:int64);
Begin
        if vt=maxso+1 then
        Begin
          Inc(spt);
          L[spt]:=so;
          exit;
        End;
        Gen(vt+1,so*10+4);
        Gen(vt+1,so*10+7);
End;

Function lucky(so:longint):boolean;
var i:longint;
st:string;
Begin
        str(so,st);
        For i:=1 to length(st) do
        if Not((st[i]='4') or (st[i]='7')) then exit(false);
        Exit(true);
end;

Procedure Process;
var i:longint;
begin

        FOr maxso:=1 to 10 do
        Gen(1,0);

        gt[0]:=1;
        FOr i:=1 to n do
        Begin
          gt[i]:=gt[i-1]*i;
          if gt[i]>k then
          begin
            scs:=i;
            gh:=n-scs;
            break;
          End;
        End;

        if k>gt[i] then
        Begin
          writeln(f2,-1);
          exit;
        End;
        if gt[i]=k then scs:=n;
        TimSH(scs);
        For i:=1 to scs do
          KQ[i]:=KQ[i]+gh;
        For i:=1 to spt do
        if L[i]<=gh then
        Inc(res);
        For i:=1 to scs do
        if lucky(KQ[i]) and (lucky(i+gh)) then
        inc(res);
        writeln(f2,res);
end;

Begin
        assign(f1,'');reset(f1);
        assign(f2,'');rewrite(f2);
        readln(f1,n,k);
        Process;
        close(f1);
        close(f2);
End.

const  abc=1000000000000;
var  n,m,p,k:longint;
     s:int64;
     a:array[0..1111]of int64;
     kt:array[0..20]of boolean;
     res:longint;

procedure create(s:string);
var  code:longint;
begin
     if length(s) >9 then exit;
     if s<>'' then
     begin
          inc(m);
          val(s,a[m],code);
     end;
     create(s+'4');
     create(s+'7');
end;

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

procedure check;
var  i:longint;
begin
     s:=1;
     p:=0;
     for i:=1 to n do
     if s*i>abc then break
     else
     begin
          inc(p);
          s:=s*i;
     end;

     if k>s then
     begin
          writeln(-1);
          halt;
     end;
end;

function chk(x:longint):boolean;
var  s:string;
     i:longint;
begin
     str(x,s);
     if s='' then exit(false);
     for i:=1 to length(s) do
     if (s[i]<>'4') and (s[i]<>'7') then exit(false);
     exit(true);
end;

procedure timhoanvi;
var  i,j,t,count:longint;
begin
     for i:=1 to p do
     begin
          s:=s div (p-i+1);

          t:=(k+s-1) div s;
          k:=k-(t-1)*s;
          count:=0;
          for j:=1 to p do
          if kt[j]=false then
          begin
               inc(count);
               if count=t then break;
          end;

          kt[j]:=true;

          if chk(n-p+i) and chk(n-p+j) then inc(res);
     end;
end;

procedure tinh;
var  i:longint;
begin
     res:=0;
     for i:=1 to m do
     if a[i]<=n-p then inc(res)
     else break;

     timhoanvi;
end;

begin
     readln(n,k);
     check;
     m:=0;
     create('');
     sort(1,m);
     tinh;
     writeln(res);
     readln;
end.

var a1:array[1..5000] of qword;
    a:array[1..20] of qword;
    ans:array[1..20] of longint;
    bo:array[1..20] of boolean;
    i,j,n,k,n1,tot,sum:longint;
    t,cator:qword;
    flag:boolean;
procedure dfs(m:longint; s:string);
  var t:qword;
  begin
    if m>10 then exit;
    if m>0 then
     begin
       val(s,t);
       inc(tot);
       a1[tot]:=t;
     end;
    dfs(m+1,s+'4');
    dfs(m+1,s+'7');
  end;
function cal(x:longint):qword;
  var i:longint;
      s:qword;
  begin
   s:=1;
   for i:=1 to x do s:=s*i;
   exit(s);
  end;
function check(x:longint):boolean;
  var i,t:longint;
      s:string;
  begin
    t:=x+n1;
    str(t,s);
    for i:=1 to length(s) do
     if (s[i]<>'4')and(s[i]<>'7') then exit(false);
    t:=ans[x]+n1;
    str(t,s);
    for i:=1 to length(s) do
     if (s[i]<>'4')and(s[i]<>'7') then exit(false);
    exit(true);
  end;
begin
  fillchar(bo,sizeof(bo),false);
  readln(n,k);
  flag:=false;
  cator:=1;
  for i:=1 to n do
   begin
     cator:=cator*i;
     if cator>=k then
      begin
        flag:=true;
        break;
      end;
   end;
  if not flag then
   begin
     writeln('-1');
     halt;
   end;
  if n>15 then
   begin
     n1:=n-15;
     n:=15;
     dfs(0,'');
     for i:=1 to tot-1 do
      for j:=i+1 to tot do
       if a1[i]>a1[j] then
        begin
          t:=a1[i];
          a1[i]:=a1[j];
          a1[j]:=t;
        end;
     for i:=1 to tot do
      if a1[i]<=n1 then inc(sum)
                   else break;
   end;
  cator:=k-1;
  for i:=n-1 downto 1 do
   begin
     flag:=false;
     a[n-i]:=cator div cal(i);
     cator:=cator mod cal(i);
     t:=0;
     j:=1;
     while (j<=n)and not flag do
      if not bo[j] then begin
                          inc(t);
                          if t=a[n-i]+1 then begin
                                               ans[n-i]:=j;
                                               flag:=true;
                                               bo[j]:=true;
                                             end
                                        else inc(j);
                        end
                   else inc(j);
   end;
  for i:=1 to n do
   if not bo[i] then
    begin
      ans[n]:=i;
      break;
    end;
  for i:=1 to n do
   if check(i) then inc(sum);
  writeln(sum);
end.

const
        fi='';
var
        f:Text;
        k,kq,m:longint;
        g:array [1..13,1..13] of longint;
        kt:array [1..13] of boolean;
        a,v,b:array [1..13] of longint;
        d:array [1..10] of boolean;
        lucky:array [1..2046]  of int64;
        n:int64;
procedure nhap;
begin
        assign(f,fi);
        reset(f);
        readln(f,n,k);
        close(f);
end;
function ck(u:longint):boolean;
var
        x:longint;
begin
        x:=u;
        while x>0 do
        begin
                if (x mod 10<>4) and (x mod 10<>7) then exit(false);
                x:=x div 10;
        end;
        exit(true);
end;
procedure cb;
var
        i,j,u:longint;
begin
        g[1,1]:=1;
        g[2,1]:=1; g[2,2]:=1; u:=2;
        for i:=3 to 13 do
        begin
                for j:=1 to i do g[i,j]:=g[i-1,j]*u;
                g[i,i]:=g[i,i-1];
                inc(u);
        end;
end;
procedure lam1;
var
        i,j,u,s,d,o:longint;
begin
        u:=n; fillchar(kt,sizeof(kt),true);
        for i:=n downto 1 do
        begin
                s:=0; d:=0; o:=1;
                for j:=1 to i do
                begin
                        s:=s+g[i,j]; inc(d);
                        if s>=k then
                        begin
                                s:=s-g[i,j]; dec(d);
                                k:=k-s;
                                o:=0;
                                break;
                        end;
                end;
                if o=1 then
                begin
                        writeln(-1);
                        halt;
                end;
                s:=0;
                for j:=1 to n do
                if kt[j] then
                begin
                        inc(s);
                        if s>d then
                        begin
                                a[n-i+1]:=j;
                                kt[j]:=false;
                                break;
                        end;
                end;
        end;
        kq:=0;
        for i:=1 to n do
        if (ck(i)) and (ck(a[i])) then inc(kq);
        writeln(kq);
end;
procedure sinh(u,le:longint);
    var
            i:longint;
            so:int64;
    begin
            if u>le then
            begin
                    so:=0;
                    for i:=1 to le do
                    begin
                            so:=so*10;
                            if d[i] then so:=so+4
                            else so:=so+7;
                    end;
                    inc(m);
                    lucky[m]:=so;
            end
            else
            begin
                    d[u]:=true;
                    sinh(u+1,le);
                    d[u]:=false;
                    sinh(u+1,le);
            end;
    end;
    procedure quicksort(l,r:longint);
    var
            i,j:longint;
            p,t:int64;
    begin
            if l>=r then exit;
            i:=l; j:=r;
            p:=lucky[(i+j) div 2];
            repeat
                    while lucky[i]<p do inc(i);
                    while lucky[j]>p do dec(j);
                    if i<=j then
                    begin
                            t:=lucky[i]; lucky[i]:=lucky[j]; lucky[j]:=t;
                            inc(i); dec(j);
                    end;
            until i>=j;
            quicksort(l,j);
            quicksort(i,r);
    end;
    procedure tao;
    var
            i:longint;
    begin
            m:=0;
            for i:=1 to 10 do
            begin
                    fillchar(d,sizeof(d),true);
                    sinh(1,i);
            end;
            quicksort(1,m);
    end;
procedure lam2;
var
        i,j,u,s,d,o:longint;
begin
        u:=n; fillchar(kt,sizeof(kt),true);
        for i:=13 downto 1 do
        begin
                s:=0; d:=0;  o:=1;
                for j:=1 to i do
                begin
                        s:=s+g[i,j]; inc(d);
                        if s>=k then
                        begin
                                s:=s-g[i,j]; dec(d);
                                k:=k-s;
                                o:=0;
                                break;
                        end;
                end;
                if o=1 then
                begin
                        writeln(-1);
                        halt;
                end;
                s:=0;
                for j:=1 to 13 do
                if kt[j] then
                begin
                        inc(s);
                        if s>d then
                        begin
                                a[13-i+1]:=j;
                                kt[j]:=false;
                                break;
                        end;
                end;
        end;
        for i:=1 to 13 do v[i]:=n-13+i;
        for i:=1 to 13 do b[i]:=n-13+a[i];
        tao;
        kq:=0;
        for i:=1 to 2046 do
        begin
                if lucky[i]=n-13 then
                begin
                        kq:=i;
                        break;
                end
                else
                if lucky[i]>n-13 then
                begin
                        kq:=i-1;
                        break;
                end;
        end;
        for i:=1 to 13 do
        if (ck(b[i])) and (ck(v[i])) then inc(kq);
        writeln(kq);
end;
procedure xuly;
begin
        if n<=13 then lam1
        else lam2;
end;
begin
        nhap;
        cb;
        xuly;
end.

{$mode objfpc}
const
       fi = '';
        fo=  '';
        maxN = 10000000;
        nlk = 1023;
var
         n , m,k,count : integer;
         res : int64 ;
         lk,a : array[0..nlk] of int64;
         gt : array[0..30] of int64;
         f : text ;

Procedure enter;
var i : integer;
begin
     assign(f,fi) ; reset(f);
     readln(f,n,m);
     close(F) ;
     gt[1] := 1;
     for i := 2 to 15 do gt[i] := gt[i-1] * i ;
end ;

Procedure cal( i : int64 );

var    x : int64;

begin
       if i >= 1000000000 then exit ;
       inc(n) ;
       lk[n] := i ;
       x:= i ;
       i := x * 10 + 4;
       cal(i) ;
       i := x * 10 + 7;
       cal(i);

end ;

procedure qsort(l,h : integer);
var i , j , pivot : integer;

begin
     if l >= h then exit ;
     i := random( h - l + 1) + l ;
     pivot :=lk[ i] ; lk[i] := lk[l] ;
     i := l ;
     j := h ;
     repeat
                  while (i<j) and (lk[j] > pivot) do dec(j) ;
                  if i < j then begin
                                 lk[i] :=lk[j];
                                 inc(i);
                  end else break;
                  while (i<j ) and (lk[i] < pivot) do inc(i) ;
                  if i < j then begin
                                  lk[j] := lk[i];
                                  dec(j);
                  end else break ;
     until i = j ;
     lk[i] := pivot;
     qsort(l,i-1);
     qsorT(i+1,h) ;
end ;

Procedure process1;
 var
 i ,j , k : integer;
 check : array[0..20] of boolean;
 sum : int64;
  Begin

   j :=  n -1;
   fillchar(check , sizeof(check) , false);
   i :=1;
  repeat
  sum :=0;
  k := 0;
   for i := 1  to n do
    begin
    if not check[i] then

      if (sum < m) then
         begin
        sum := sum + gt[j];
        k := i;
         end
      else break;
    end;
   i := k ;
//   write(f ,i , ' ');
inc(count) ;
a[ count ] := i ;
   Check[i ] := true;
   dec(j);
   m := m -sum + gt[j + 1];
  until j <= 0;

  for i := 1 to n do if not check[i] then begin
     inc(count) ;
       a[count] := i ;
       end ;

   ENd;

function ok( x : int64) : boolean ;
var i : integer;
begin
                while x > 0 do
                 begin
                      i := x mod 10 ;
                      if ( i<>4) and ( i<>7) then exit(false);
                      x := x div 10 ;
                 end ;
                 result := true ;
end ;

Procedure process;
var i , j , k : integer;

begin
     j := n ;
     k := 0 ;
     if n > 15 then begin
       k := n - 15;
      n := 15;
      end ;

     if m > gt[n] then begin
          writeln(-1) ;
          halt ;
     end ;
     process1;

//     for i := 1 to n do inc(a[i], n  ) ;
     for i := 1 to n do
      if ok(i+k) and ok(a[i]+k) then inc(res) ;

     n := j;
     for i := 2 to nlk do begin

      if lk[i] > n - 15 then break ;
            inc(res) ;
      end ;

//     if res = 0 then res := -1;
     writeln(Res);
end ;
begin
     cal(0) ;qsort(1,nlk) ;
     enter;

     process;
end.

uses
  math;
var
  a,fact:array[0..13] of int64;
  ans,n,k:int64;
  i:longint;

function check(x:int64):boolean;
var
  z:int64;
begin
  check:=false;
  if (x>n) then exit;
  z:=n-x+1;
  if (z<=13) then z:=a[z] else z:=x;
  while (z<>0) do
  begin
    if (z mod 10<>4) and (z mod 10<>7) then exit;
    z:=z div 10;
  end;
  check:=true;
end;

procedure swap(i,j:longint);
var
  x:int64;
begin
  x:=a[i]; a[i]:=a[j]; a[j]:=x;
end;

procedure rec(nom,ost:int64);
var
  x:int64;
  i,j:longint;
  good:boolean;
begin
  if (nom=0) then exit;
  good:=false;
  for i:=nom downto 1 do
  begin
    x:=(nom-i+1)*fact[nom-1];
    if (ost<=x) then begin swap(nom,i); good:=true; break; end;
  end;
  if (not good) then begin writeln('-1'); halt; end;
  for i:=1 to nom-1 do for j:=i+1 to nom-1 do if (a[i]<a[j]) then swap(i,j);
  rec(nom-1,ost-x+fact[nom-1])
end;

procedure gen(nom,x:int64);
begin
  if (nom<>1) and (check(x)) then inc(ans);
  if (nom=10) then exit;
  gen(nom+1,x*10+4);
  gen(nom+1,x*10+7);
end;

begin
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 13 do fact[i]:=fact[i-1]*i;
  for i:=min(13,n) downto 1 do a[i]:=n-i+1;
  rec(min(13,n),k);
  gen(1,0);
  writeln(ans);
end.

{$mode objfpc}
var f:text;
    n,k:longint;
    a,b:array[0..13] of int64;
    pivot,m,l:int64;
    q:array[1..1100] of int64;
    first,last:longint;
    dem:longint;

procedure input;
begin
  assign(f,'');
  reset(f);
  readln(f,n,k);
  close(f);
end;

procedure push(x:int64);
begin
  inc(last);
  q[last]:=x;
end;

function pop:int64;
begin
  pop:=q[first];
  inc(first);
end;

procedure init;
var u,v:int64;
    i:longint;
begin
  dem:=0;
  pivot:=1;
  b[0]:=1;
  b[1]:=1;
  first:=1;
  last:=0;
  while k>b[pivot] do
    begin
      inc(pivot);
      b[pivot]:=b[pivot-1]*pivot;
    end;
  m:=pivot;
  l:=n-pivot+1;
  if l<=0 then
    begin
      dem:=-1;
      exit;
    end;
  if 4<l then
    begin
      push(4);
      inc(dem);
    end;
  if 7<l then
    begin
      push(7);
      inc(dem);
    end;
  while first<=last do
    begin
      u:=pop;
      v:=u*10+4;
      if v<l then
        begin
          push(v);
          inc(dem);
        end;
      v:=u*10+7;
      if v<l then
        begin
          push(v);
          inc(dem);
        end;
    end;
  for i:=l to n do
    begin
      a[i-l+1]:=i;
      //writeln(i);
    end;
end;

procedure qs(l,h:longint);
var i,j:longint;
    pivot:int64;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l];
  i:=l;
  j:=h;
  repeat
    while (i<j) and (a[j]>pivot) do dec(j);
    if i<j then
      begin
        a[i]:=a[j];
        inc(i);
      end
    else break;

    while (i<j) and (a[i]<pivot) do inc(i);
    if i<j then
      begin
        a[j]:=a[i];
        dec(j);
      end
    else break;
  until i=j;
  a[i]:=pivot;
  qs(l,i-1);
  qs(i+1,h);
end;

function kt(v:int64):boolean;
var u:longint;
begin
  while v<>0 do
    begin
      u:=v mod 10;
      if u<>4 then
        if u<>7 then exit(false);
      v:=v div 10;
    end;
  exit(true);
end;

procedure swap(var a,b:int64);
var temp:int64;
begin
  temp:=a;
  a:=b;
  b:=temp;
end;

procedure solve;
var i:longint;
begin
  while k<>0 do
    for i:=1 to pivot do
      if (k>(int64(i)-1)*b[pivot-1]) and (k<=(int64(i)*b[pivot-1])) then
        begin
          swap(a[m-pivot+i],a[m-pivot+1]);
          qs(m-pivot+2,m);
          k:=k-(int64(i)-1)*b[pivot-1];
          if k=1 then exit;
          dec(pivot);
        end;
end;

procedure output;
var i:longint;
begin
  if dem<>-1 then
    for i:=1 to m do
      if kt(a[i]) and kt(i+l-1) then inc(dem);
  writeln(dem);
end;

begin
  input;
  init;
  if dem<>-1 then solve;
  output;
end.

var
        z:int64;
        p:array[0..1025]of boolean;
        a,s:array[0..1025]of int64;
        ans,n,m,x,i,j,k,t:Longint;

function pd(x:longint):boolean;
begin
        while x>0 do begin
          if (x mod 10<>4) and (x mod 10<>7) then exit(false);
          x:=x div 10;
        end;
        exit(true);
end;

begin
        s[0]:=1; for i:=1 to 13 do s[i]:=s[i-1]*i;
        read(n,m); dec(m);
        if (n<=13) and (m+1>s[n]) then begin writeln(-1); exit end;
        t:=13; if t>n then t:=n; k:=n-t+1;
        a[1]:=4; a[2]:=7; j:=2; i:=0;
        repeat
          inc(i);
          z:=a[i]*10+4; if z<k then begin inc(j); a[j]:=z end;
          z:=z+3;       if z<k then begin inc(j); a[j]:=z end;
        until i=j;
        if k<=4 then ans:=0 else if k<=7 then ans:=1 else ans:=j; x:=t;
        for i:=k to n do begin
          dec(t);
          z:=m div s[t]; m:=m mod s[t];
          for j:=1 to x do begin
            if (z=0) and not p[j] then begin p[j]:=true; break; end;
            if not p[j] then dec(z);
          end;
          if pd(j+k-1) and pd(i) then inc(ans);
        end;
        writeln(ans);
end.

var
  n,k,temp,t:int64;
  i,j,ans,nn:longint;
  a:array[0..1 shl 12] of int64;
  fact:array[0..15] of int64;
  used:array[0..15] of boolean;
  z,s:array[0..15] of longint;
procedure lucky(x:int64);
  begin
    if x>10000000000 then exit;
	inc(nn); a[nn]:=x;
	lucky(10*x+4); lucky(10*x+7);
  end;

function islucky(a:int64):boolean;
  begin
    if a=0 then exit(true)
	else if not ((a mod 10) in [4,7]) then exit(false)
	else exit(islucky(a div 10));
  end;

begin
  lucky(4); lucky(7);
  for i:=1 to nn-1 do
    for j:=nn downto i+1 do
	  if a[j]<a[j-1] then
	    begin
		  temp:=a[j]; a[j]:=a[j-1]; a[j-1]:=temp;
		end;
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=fact[i-1]*i;
  if n<15 then
    if k>fact[n] then
	  begin
	    writeln(-1);halt;
	  end;
  dec(k);
  fillchar(used,sizeof(used),false);
  if n>15 then
    begin
	  temp:=n; n:=15;
	end
  else temp:=0;
  for i:=1 to n do z[i]:=i;
  for i:=1 to n do
    begin
	  t:=k div fact[n-i];
	  k:=k-t*fact[n-i];
	  s[i]:=z[t+1];
	  for j:=t+1 to n-1 do
	    z[j]:=z[j+1];
	end;
  if temp>15 then
    begin
	  for i:=1 to 15 do
	    if islucky(temp-15+int64(i)) and islucky(temp-15+int64(s[i])) then inc(ans);
	  for i:=1 to nn do
	    if a[i]>temp-15 then break
		  else inc(ans);
	end
  else for i:=1 to n do
    if islucky(int64(i)) and islucky(int64(s[i])) then inc(ans);
  writeln(ans);

end.

const
{     fi='per.inp';
     fo='per.out';}
     fi='';
     fo='';
     maxn=3003;

var
     f:text;
     gt,c,d,a,b:array[0..maxn]of int64;
     ok:array[0..maxn]of boolean;
     spt,n,k:longint;

function maxx(x,y:longint):longint;
begin
     maxx:=x;
     if y>x then maxx:=y;
end;

function minn(x,y:longint):longint;
begin
     minn:=x;
     if y<x then minn:=y;
end;

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

procedure open;
var  i:longint;
begin
     assign(f,fi);reset(f);
     readln(f,n,k);
     close(f);
end;

procedure check(l:longint);
var  i:longint;
     s:int64;
begin
     s:=0;
     for i:=1 to l do s:=s*10+a[i];
     inc(spt);
     b[spt]:=s;
end;

procedure try(i,l:byte);
var  j:byte;
begin
     if i>l then check(l)
     else
     for j:=1 to 2 do
     begin
          if j=1 then a[i]:=4
          else a[i]:=7;
          try(i+1,l);
     end;
end;

function luck(x:int64):boolean;
begin
     while x<>0 do
     begin
          if (x mod 10<>4) and (x mod 10<>7) then exit(false);
          x:=x div 10;
     end;
     luck:=true;
end;

procedure main;
var  i,kq,j,t,m:longint;
begin
     spt:=0;
     for i:=1 to 10 do try(1,i);
     gt[0]:=1;
     for i:=1 to 13 do gt[i]:=gt[i-1]*i;
     for i:=1 to spt do d[i]:=b[i];

     if (n<=13) and (gt[n]<k) then kq:=-1
     else
     begin
          for m:=1 to 13 do
               if gt[m]>=k then break;
          fillchar(ok,sizeof(ok),true);
          for i:=1 to m do
          begin
               for j:=1 to m do
                    if ok[j] then
                         if k<=gt[m-i] then break
                         else k:=k-gt[m-i];
               c[i]:=j;
               ok[j]:=false;
          end;
          for i:=1 to m do
          begin
               j:=n-m+c[i];
               if luck(j) then
                    for t:=1 to spt do
                         if b[t]=j then
                         begin
                              d[t]:=n-m+i;
                              break;
                         end;
          end;
          kq:=0;
          for i:=1 to spt do
               if b[i]<=n then
                    if luck(d[i]) then inc(kq);
     end;

     assign(f,fo);rewrite(f);
     writeln(f,kq);
     close(F);
end;

begin
     open;
     main;
end.

var
  a,b,rr,mar :array [1..10000] of int64;
  s:string;
  code: integer;
  n,nn,f,y,u,r,v,ans,k,w,e,x,h : int64;
  i,j,ii : longint;
  function fact(x : int64) : int64;
  var
  i: longint;
  e: int64;
   begin
    e:=1;
    for i:=1 to x do e:=e*i;
    fact:=e;
   end;
  function pos(x : int64) : boolean;
   begin
    pos:=false;
    for ii:=1 to v do
    if a[ii]=x then begin pos:=true; exit; end;
   end;
  function maxx(x: int64): int64;
  var
  i,f,e : longint;
  begin
  e:=x;
  f:=0;
   for i:=1 to n-f+1 do
   if mar[i]=0 then
    begin
     inc(f);
     if f=x then begin e:=i;break;end;
    end;
    maxx:=e;
  end;
begin
  readln(n,k);
  i:=1;
  y:=1;
  while (y<k) and (i<=n) do
   begin
    y:=y*i;
    inc(I);
   end;
  r:=i-1;
  if y<k then begin writeln(-1);exit;end;
  nn:=1;
  while (nn<=10) do
   begin
    s:='';
    for i:=1 to nn do s:=s+'4';
    val(s,e,code);
    if e>n then break;
    inc(v);
    a[v]:=e;
    while true do
     begin
      j:=nn;
      while (j>=1) and (s[j]='7') do begin s[j]:='4'; dec(j); end;
      if j<1 then break;
      s[j]:='7';
      val(S,e,code);
      if e>n then break
      else
      begin
      inc(v);
      a[v]:=e;
      end;
     end;
     inc(nn);
   end;
  if e=0 then begin writeln(0);exit; end;
  f:=n-r+1;
  for i:=1 to v do
  if a[i]>=f then begin inc(u); b[u]:=a[i];end
  else
  inc(ans);
  for i:=f to n do
  for j:=1 to u do
   if i=b[j] then begin inc(h); rr[h]:=i-f+1;end;
  for i:=1 to n-f do
  begin
   e:=n-f+1-i;
   w:=fact(e);
   x:=k div w;
   if k mod w<>0 then inc(X);
   x:=maxx(x);
   for j:=1to h do
    if (rr[j]=x) and (pos(i+f-1)) then inc(ans);
   mar[x]:=1;
   k:=k mod w;
   if k=0 then k:=w;
  end;
 for i:=1 to n-f+1 do
 if mar[i]=0 then
  begin
    for j:=1to h do
    if (rr[j]=i) and (pos(n)) then inc(ans);
  end;
 writeln(ans);
end.

Program Lucky_Permutation;
Const
    MAXN                            =15+10;
    OO                              =987654321;
Var
    n,m,ans                         :longint;
    flag                            :array[0..MAXN] of boolean;
    c                               :array[0..MAXN] of int64;

Function Change(x:int64):int64;
Var
    i,j,k                           :longint;
    d                               :int64;
begin
    if x=0 then exit(4);
    d:=1;
    while d<=x do
    begin
        if x mod (d*10) div d=4 then
        begin
            x:=x+d*3;
            if d<>1 then
            begin
                d:=d div 10;
                while d>0 do
                begin
                    if x mod (d*10) div d=7 then
                        x:=x-3*d;
                    d:=d div 10;
                end;
            end;
            exit(x);
        end;
        d:=d*10;
    end;
    x:=0;
    while d>0 do
    begin
        x:=x+d*4;
        d:=d div 10;
    end;
    exit(x);
end;

Function Check(x:longint):boolean;
Var
    k                               :longint;
begin
    while x>0 do
    begin
        k:=x mod 10;
        if (k<>4) and (k<>7) then exit(false);
        x:=x div 10;
    end;
    exit(true);
end;

Procedure Main;
Var
    i,j,k,len,l                     :longint;
    now                             :int64;
begin
    readln(n,m);
    c[0]:=1;
    for i:=1 to 15 do c[i]:=c[i-1]*i;
    if (n<=15) and (c[n]<m) then
    begin
        writeln('-1');
        halt;
    end;dec(m);
    for i:=1 to 15 do
    if c[i]>m then break;
    len:=i;now:=4;
    while now<=n-len do
    begin
        inc(ans);
        now:=change(now);
    end;
    for i:=len-1 downto 0 do
    begin
        k:=m div c[i];
        j:=0;
        for l:=0 to k do
        begin
            inc(j);
            while flag[j] do inc(j);
        end;
        flag[j]:=true;
        if check(n-len+j) and check(n-i) then inc(ans);
        m:=m mod c[i];
    end;
    writeln(ans);
end;

Begin
    Main;
End.

{$apptype console}
{$R+,S+,I+,Q+}
const
     inf = 'input.txt';
     outf = 'output.txt';
var
 n,k,m,ans,i,j,x,y:longint;
 f:array[0..99] of int64;
 was:array[0..99] of boolean;

 function lucky(x:int64):boolean;
  begin
   lucky:=false;
   while x > 0 do
    begin
     if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
     x:=x div 10;
    end;
   lucky:=true;
  end;

 procedure rec(x:int64);
  begin
   if x <= n-m then
    begin
     inc(ans);
     rec(x*10+4);
     rec(x*10+7);
    end;
  end;

begin
 //reset(input,inf);
 //rewrite(output,outf);
 read(n,k);
 f[0]:=1;
 m:=0;
 while f[m] < k do
  begin
   inc(m);
   f[m]:=f[m-1]*m;
  end;
 if m > n then
  begin
   writeln(-1);
   halt;
  end;
 ans:=0;
 rec(0);
 dec(ans);
 fillchar(was,sizeof(was),false);
 for i:=1 to m do
  begin
   x:=1;
   while k > f[m-i] do
    begin
     inc(x);
     dec(k,f[m-i]);
    end;
   y:=0;
   for j:=1 to x do
    begin
     inc(y);
     while was[y] do inc(y);
    end;
   was[y]:=true;
   if lucky(n-m+i) and lucky(n-m+y) then inc(ans);
  end;
 writeln(ans);
end.

program cf121c;
var
  n,i,j,xx,jj,nn:longint;
  jc:array[0..1000]of int64;
  kk,ans,t:int64;
  dl,ne,xl:array[0..10000]of int64;
procedure dfs(o:int64);
begin
  if o<=4444444444 then begin
    inc(dl[0]);
   // writeln(o);
    dl[dl[0]]:=o;
    dfs(o*10+4);
    dfs(o*10+7);
  end;
end;

function kind(x:longint):boolean;
begin
  while x<>0 do begin
    if (x mod 10<>4)and(x mod 10<>7) then exit(false);
    x:=x div 10;
  end;
  exit(true);
end;

begin
  dl[0]:=0;
  dfs(4);
  dfs(7);

  for i:=1 to dl[0] do
    for j:=i+1 to dl[0] do
      if dl[j]<dl[i] then begin
        t:=dl[i];dl[i]:=dl[j];dl[j]:=t;
      end;

//init-----------------------------/

  jc[0]:=1;
  for i:=1 to 1000 do begin
    jc[i]:=jc[i-1]*i;
    if jc[i]>1000000000 then break;
  end;
  readln(n,kk);

  j:=n;
  while (jc[n-j+1]<kk) do begin
    dec(j);
    if j=0 then begin
      writeln(-1);
      halt;
    end;
  end;

  ans:=0;
  for i:=1 to dl[0] do
    if dl[i]<=j then inc(ans);

  jj:=j-1;
  nn:=n-j+1;
  for i:=1 to nn do ne[i-1]:=i;
  for i:=1 to nn do begin
    xx:=0;
    j:=ne[0];
    while kk>jc[nn-i] do begin
      xx:=j;
      j:=ne[j];
      kk:=kk-jc[nn-i];
    end;
    ne[xx]:=ne[j];
    xl[i]:=j;
  end;

  for i:=1 to nn do
    if (kind(jj+xl[i]))and(kind(jj+i)) then inc(ans);
  writeln(ans);
end.

{$R+,S+,Q+,I+,O-}
{R-,S-,Q-,I-,O+}
var
  f: array [0..99] of int64;
  n,k,i,j,m,x,y,ans: longint;
  was: array [0..99] of boolean;

procedure rec(w:int64);
begin
  if w <= n-m then
  begin
    inc(ans);
    rec(w*10+4);
    rec(w*10+7);
  end;
end;

function lucky(t:int64):boolean;
begin
  while t > 0 do
  begin
    if (t mod 10 <> 4) and (t mod 10 <> 7) then
    begin
      lucky:=False;
      exit;
    end;
    t:=t div 10;
  end;
  lucky:=True;
end;

begin
//  assign(input,'in'); reset(input);
//  assign(output,'out'); rewrite(output);
  f[0]:=1;
  for i:=1 to 10 do f[i]:=f[i-1]*i;
  read(n,k);
  m:=0;
  for i:=1 to n do
    if f[i] >= k then
    begin
      m:=i;
      break;
    end;
  if m = 0 then
  begin
    writeln('-1');
    halt;
  end;
  ans:=0;
  rec(4); rec(7);
  fillchar(was,sizeof(was),False);
  for i:=1 to m do
  begin
    x:=0; y:=1;
    while k > f[m-i] do
    begin
      k:=k-f[m-i];
      inc(y);
    end;
    for j:=1 to y do
    begin
      inc(x);
      while was[x] do inc(x);
    end;
    was[x]:=True;
    if lucky(n-m+i) and lucky(n-m+x) then inc(ans);
  end;
  writeln(ans);
  close(input);
  close(output);
end.

{$MODE OBJFPC}
//(a/b) mod p=a*(b^(p-2)) mod p
const
  fo='';
  fi='';
var
  n,k,kq:integer;
  tt:int64;
  head:integer;
  first,last:integer;
  p:array[1..100000] of int64;
  ak:array[0..15] of int64;
  a:array[1..15] of integer;
procedure input;
var f:textfile; i,j:integer;
begin
  assign(f,fo);
  reset(f);
  readln(f,n,k);
  close(f);
end;
procedure find;
var i,j:int64;
begin
  i:=1;
  j:=1;
  ak[1]:=1;
  ak[0]:=0;
  while k>i do
  begin
    inc(j);
    i:=i*j;
    ak[j]:=i;
  end;
  head:=n;
  while (head>=0) and (k>ak[n-head]) do dec(head);
end;
procedure init;
begin
  first:=1;
  last:=0;
end;
procedure push(i:integer);
begin
  inc(last);
  p[last]:=i;
end;
function pop:integer;
begin
  result:=p[first];
  inc(first);
end;
procedure solve;
var i,j,u,v:integer;
begin
  init;
  push(4);
  push(7);
  kq:=0;
  if 4<=head then inc(kq);
  if 7<=head then inc(kq);
  while first<=last do
  begin
    u:=pop;
    v:=u*10+4;
    if v<=head then begin inc(kq); push(v); end;
    v:=u*10+7;
    if v<=head then begin inc(kq); push(v); end;
  end;
end;
procedure QS(l,h:integer);
var i,j:integer; pivot:integer;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l]; i:=l; j:=h;
  repeat
  while (i<j) and (a[j]>pivot) do dec(j);
  if i<j then begin a[i]:=a[j]; inc(i); end else break;
  while (i<j) and (pivot<a[i]) do inc(i);
  if i<j then begin a[j]:=a[i]; dec(j); end else break;
  until i=j;
  a[i]:=pivot;
  QS(l,i-1);
  QS(i+1,h);
end;
procedure QS2(l,h:integer);
var i,j:integer; pivot:integer;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l]; i:=l; j:=h;
  repeat
  while (i<j) and (a[j]<pivot) do dec(j);
  if i<j then begin a[i]:=a[j]; inc(i); end else break;
  while (i<j) and (pivot>a[i]) do inc(i);
  if i<j then begin a[j]:=a[i]; dec(j); end else break;
  until i=j;
  a[i]:=pivot;
  QS2(l,i-1);
  QS2(i+1,h);
end;
function check(i:integer):boolean;
begin
  while i>0 do
  begin
    if ((i mod 10)<>4) and ((i mod 10)<>7) then exit(false);
    i:=i div 10;
  end;
  exit(true);
end;
procedure solve2;
var i,u,v,cc,d,t:integer;
begin
  u:=head+1;
  for i:=u to n do a[i-head]:=i;
  v:=n-head;
  cc:=0;
  while (k>1) and (cc<v) do
  begin
    inc(cc);
    if k>=ak[v-cc] then
    begin
      d:=k div ak[v-cc];
      if k mod ak[v-cc]=0 then
      begin
        d:=d+cc-1;
        t:=a[cc];
        a[cc]:=a[d];
        a[d]:=t;
        k:=0;
        QS2(cc+1,v);
      end
      else
      begin
        k:=k-d*ak[v-cc];
        d:=d+cc;
        t:=a[cc];
        a[cc]:=a[d];
        a[d]:=t;
        QS(cc+1,v);
      end;
    end;
  end;
  for i:=1 to v do
    if check(a[i]) and check(i+head) then inc(kq);
end;
procedure output;
var f:textfile; i:integer;
begin
  assign(f,fi);
  rewrite(f);
  if head<0 then writeln(f,-1) else
  writeln(f,kq);
  close(f);
end;
begin
  input;
  find;
  if head>=0 then
  begin
  solve;
  solve2;
  end;
  output;
end.

{$MODE OBJFPC}
//(a/b) mod p=a*(b^(p-2)) mod p
const
  fo='';
  fi='';
var
  n,k,kq:integer;
  tt:int64;
  head:integer;
  first,last:integer;
  p:array[1..100000] of int64;
  ak:array[0..15] of int64;
  a:array[1..15] of integer;
procedure input;
var f:textfile; i,j:integer;
begin
  assign(f,fo);
  reset(f);
  readln(f,n,k);
  close(f);
end;
procedure find;
var i,j:int64;
begin
  i:=1;
  j:=1;
  ak[1]:=1;
  ak[0]:=0;
  while k>i do
  begin
    inc(j);
    i:=i*j;
    ak[j]:=i;
  end;
  head:=n;
  while (head>=0) and (k>ak[n-head]) do dec(head);
end;
procedure init;
begin
  first:=1;
  last:=0;
end;
procedure push(i:integer);
begin
  inc(last);
  p[last]:=i;
end;
function pop:integer;
begin
  result:=p[first];
  inc(first);
end;
procedure solve;
var i,j,u,v:integer;
begin
  init;
  push(4);
  push(7);
  kq:=0;
  if 4<=head then inc(kq);
  if 7<=head then inc(kq);
  while first<=last do
  begin
    u:=pop;
    v:=u*10+4;
    if v<=head then begin inc(kq); push(v); end;
    v:=u*10+7;
    if v<=head then begin inc(kq); push(v); end;
  end;
end;
procedure QS(l,h:integer);
var i,j:integer; pivot:integer;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l]; i:=l; j:=h;
  repeat
  while (i<j) and (a[j]>pivot) do dec(j);
  if i<j then begin a[i]:=a[j]; inc(i); end else break;
  while (i<j) and (pivot<a[i]) do inc(i);
  if i<j then begin a[j]:=a[i]; dec(j); end else break;
  until i=j;
  a[i]:=pivot;
  QS(l,i-1);
  QS(i+1,h);
end;
procedure QS2(l,h:integer);
var i,j:integer; pivot:integer;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l]; i:=l; j:=h;
  repeat
  while (i<j) and (a[j]<pivot) do dec(j);
  if i<j then begin a[i]:=a[j]; inc(i); end else break;
  while (i<j) and (pivot>a[i]) do inc(i);
  if i<j then begin a[j]:=a[i]; dec(j); end else break;
  until i=j;
  a[i]:=pivot;
  QS2(l,i-1);
  QS2(i+1,h);
end;
function check(i:integer):boolean;
begin
  while i>0 do
  begin
    if ((i mod 10)<>4) and ((i mod 10)<>7) then exit(false);
    i:=i div 10;
  end;
  exit(true);
end;
procedure solve2;
var i,u,v,cc,d,t:integer;
begin
  u:=head+1;
  for i:=u to n do a[i-head]:=i;
  v:=n-head;
  cc:=0;
  while (k>1) and (cc<v) do
  begin
    inc(cc);
    if k>=ak[v-cc] then
    begin
      d:=k div ak[v-cc];
      if k mod ak[v-cc]=0 then
      begin
        d:=d+cc-1;
        t:=a[cc];
        a[cc]:=a[d];
        a[d]:=t;
        k:=0;
        QS2(cc+1,v);
      end
      else
      begin
        k:=k-d*ak[v-cc];
        d:=d+cc;
        t:=a[cc];
        a[cc]:=a[d];
        a[d]:=t;
        QS(cc+1,v);
      end;
    end;
  end;
  for i:=1 to v do
    if check(a[i]) and check(i+head) then inc(kq);
end;
procedure output;
var f:textfile; i:integer;
begin
  assign(f,fi);
  rewrite(f);
  if head<0 then writeln(f,0) else
  writeln(f,kq);
  close(f);
end;
begin
  input;
  find;
  if head>=0 then
  begin
  solve;
  solve2;
  end;
  output;
end.

{$mode objfpc}
const
  fi = '';//lucky.inp';
  fo = '';//lucky.out';

var
  ip, op : text;
  n, k, res : integer;
  a : array[0..13] of int64;
  vis : array[1..13] of boolean;
  cs : array[1..13] of integer; // so i + (n-pos) o vi tri nao

function check(x : int64) : boolean;
var
  s : string;
  i : integer;
begin
  str(x, s);
  for i := 1 to length(s) do if (s[i] <> '4')
    and (s[i] <> '7') then exit(false);
  result := true;
end;

procedure process;
var
  i, pos, count, j, vj, gan, luu : integer;
  u, v, d : integer;
begin
  readln(ip, n, k);
  a[1] := 1;
  for i := 2 to 13 do a[i] := a[i-1] * i;
  if (n <= 13) and (a[n] < k) then
    begin
      writeln(op, -1);
      exit;
    end;
  for i := 1 to 13 do if a[i] > k then
    begin
      pos := i;
      luu := pos;
      break;
    end;
  fillchar(vis, sizeof(vis), true);
  count := 0;
  gan := 0;
  a[0] := 1;
  while (pos > 0) and (k > 0) do
    begin
      dec(pos);
      inc(gan);
      if k mod a[pos] = 0 then u := k div a[pos]
      else u := k div a[pos] + 1;
      k := k - (u-1) * a[pos];
      vj := 0;
      for j := 1 to 13 do if vis[j] then
        begin
          inc(vj);
          if vj = u then
            break;
        end;
      vis[j] := false;
      cs[j] := gan;
    end;
  res := 0;
  for i := 1 to n-luu do
    if check(i) then
      inc(res);
  for i := n-luu+1 to n do
    if check(i) and check(cs[i-(n-luu)]) then inc(res);
  writeln(op, res);
end;

begin
  assign(ip, fi); reset(ip);
  assign(op, fo); rewrite(op);
  process;
  close(ip);
  close(op);
end.

Program C_LuckyPermutation;
Const MaxN=1024;
Var n,m,k,count:Longint;
    gt:array[0..13] of Int64;
    a,d:array[1..13] of Longint;
    arr:array[0..MaxN] of Int64;

Procedure AddResult(i:Longint);
Var j:Longint;
Begin
  Inc(m);
  arr[m]:=0;
  For j:=1 to i do arr[m]:=arr[m]*10+d[j];
End;

Procedure Try(i:Longint);
Var j:Longint;
Begin
  If i>9 then Exit;
  d[i]:=4;
  AddResult(i);
  Try(i+1);
  d[i]:=7;
  AddResult(i);
  Try(i+1);
End;

Procedure Swap(Var a,b:Int64);
Var t:Int64;
Begin t:=a; a:=b; b:=t End;

Procedure QuickSort(L,r:Longint);
Var i,j:Longint;
    k:Int64;
Begin
  If l>=r then exit;
  i:=l; j:=r;
  k:=arr[random(r-l+1)+l];
  Repeat
    While arr[i]<k do INc(i);
    While arr[j]>k do Dec(j);
    If i<=j then
      Begin
        If i<j then Swap(arr[i],arr[j]);
        Inc(i); Dec(j);
      End;
  Until i>j;
  QuickSort(l,j); QUickSort(i,r)
End;

Procedure Init;
Var i:Longint;
Begin
  Try(1);
  QuickSort(1,m);
  Inc(m); arr[m]:=4444444444; arr[0]:=-MaxLongint;
  gt[0]:=1;
  For i:=1 to 13 do gt[i]:=gt[i-1]*i;
End;

Procedure Input;
Var f:Text;
Begin
  Assign(f,''); Reset(f);
  Readln(f,n,k);
  Close(f)
End;

Function IsLuckyNum(v:Int64):Boolean;
Var k:Longint;
Begin
  While v<>0 do
    Begin
      k:=v mod 10;
      If (k<>4) and (k<>7) then Exit(False);
      v:=v div 10;
    End;
  Exit(True);
End;

Procedure Delete(t:Longint);
Var j:Longint;
Begin
  For j:=t to count-1 do a[j]:=a[j+1];
  Dec(count);
End;

Procedure Solve;
Var i,res,j,p,v:Longint;
Begin
  For i:=m downto 0 do If arr[i]<(n-12) then Break;
  res:=i;
  i:=n-12; If i<1 then i:=1;
    Begin
        For j:=i to n do a[j-i+1]:=j;
        count:=n-i+1;
        For j:=1 to count do
          Begin
            For p:=1 to count do
              If k-1<p*gt[(n-i+1)-j] then Break;
            Dec(k,(p-1)*gt[(n-i+1)-j]);
            v:=a[p]; Delete(p);
            If IsLuckyNum(v) and IsLuckyNum(i+j-1) then Inc(res);
          End;
        Writeln(res);
        Exit;
      End;
End;

BEGIN
  Input;
  Init;
  Solve;
END.

var n,m,k,count,ans,answer:int64;
    a,b:Array[0..100001] of int64;
    i,j:longint;
procedure rec(lik:int64);
var i:longint;
begin
 if lik>=1000000000 then exit;

 inc(count);
 a[count]:=lik*10+4;
 rec(a[count]);
 inc(count);
 a[count]:=lik*10+7;
 rec(a[count]);
end;

procedure swap(Var t,y:int64);
var u:int64;
begin
 u:=t; t:=y; y:=u;
end;

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

function perm(ver:int64):boolean;
var ans:int64;
    i:longint;
begin
ans:=1;
for i:= 1 to n-ver do
 begin
  ans:=ans*i;
  if ans>=m then
   begin
    perm:=true;
    exit;
   end;
 end;
 perm:=false;
end;

procedure next;
var i,k,j:longint;
begin
 for i:= n downto 2 do
  if b[i]>b[i-1] then
   begin
    if b[i]<b[n] then swap(b[i],b[i-1]) else
    swap(b[n],b[i-1]);
    for j:= i to n-1 do
     for k:= i to n-1 do
      if b[k]>b[k+1] then
       swap(B[k],b[k+1]);
       exit;
   end;
 writeln(-1);
 halt;
end;

begin
 readln(n,m);
 count:=0;
 rec(0);
 ans:=0;
 sort(1,count);
 for i:= 1 to n do
  b[i]:=i;
 for i:= 1 to m-1 do
  next;
  ans:=0;
 for i:= 1 to n do
  if b[a[i]]=a[i] then inc(ans);
 writeln(ans);
end.

var n,m,k,count,ans,answer:int64;
    a,b:Array[0..100001] of int64;
    i,j:longint;
procedure rec(lik:int64);
var i:longint;
begin
 if lik>=1000000000 then exit;

 inc(count);
 a[count]:=lik*10+4;
 rec(a[count]);
 inc(count);
 a[count]:=lik*10+7;
 rec(a[count]);
end;

procedure swap(Var t,y:int64);
var u:int64;
begin
 u:=t; t:=y; y:=u;
end;

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

function perm(ver:int64):boolean;
var ans:int64;
    i:longint;
begin
ans:=1;
for i:= 1 to n-ver do
 begin
  ans:=ans*i;
  if ans>=m then
   begin
    perm:=true;
    exit;
   end;
 end;
 perm:=false;
end;

procedure next;
var i,k,j:longint;
begin
 for i:= n downto 2 do
  if b[i]>b[i-1] then
   begin
    if b[i]<b[n] then swap(b[i],b[i-1]) else
    swap(b[n],b[i-1]);
    for j:= i to n-1 do
     for k:= i to n-1 do
      if b[k]>b[k+1] then
       swap(B[k],b[k+1]);
       exit;
   end;
 writeln(-1);
 halt;
end;

begin
 readln(n,m);
 count:=0;
 rec(0);
 ans:=0;
 sort(1,count);
 for i:= 1 to n do
  b[i]:=i;
 for i:= 1 to m-1 do
  next;
  ans:=0;
 for i:= 1 to count do
  if (a[i]<=n) and (b[a[i]]=a[i]) then inc(ans);
 writeln(ans);
end.

var n,m,k,count,ans,answer:int64;
    a,b:Array[0..100001] of int64;
    i,j:longint;
procedure rec(lik:int64);
var i:longint;
begin
 if lik>=1000000000 then exit;

 inc(count);
 a[count]:=lik*10+4;
 rec(a[count]);
 inc(count);
 a[count]:=lik*10+7;
 rec(a[count]);
end;

procedure swap(Var t,y:int64);
var u:int64;
begin
 u:=t; t:=y; y:=u;
end;

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

function perm(ver:int64):boolean;
var ans:int64;
    i:longint;
begin
ans:=1;
for i:= 1 to n-ver do
 begin
  ans:=ans*i;
  if ans>=m then
   begin
    perm:=true;
    exit;
   end;
 end;
 perm:=false;
end;

procedure next;
var i,k,j:longint;
begin
 for i:= n downto 2 do
  if b[i]>b[i-1] then
   begin
    if b[i]<b[n] then swap(b[i],b[i-1]) else
    swap(b[n],b[i-1]);
    for j:= i to n-1 do
     for k:= i to n-1 do
      if b[k]>b[k+1] then
       swap(B[k],b[k+1]);
       exit;
   end;
 writeln(-1);
 halt;
end;

function fun(lik:longint):boolean;
var i:longint;
begin
 for i:= 1 to count do
  if a[i]=lik then
   begin
    fun:=true;
    exit;
   end;
  fun:=false;
 end;

begin
 readln(n,m);
 count:=0;
 rec(0);
 ans:=0;
 sort(1,count);
 for i:= 1 to n do
  b[i]:=i;
 for i:= 1 to m-1 do
  next;
  ans:=0;
 for i:= 1 to count do
  if (fun(b[i])) and (fun(i)) then inc(ans);
 writeln(ans);
end.

var otv,n,m,i,j,k,count,answer,num,cnt,q,t,numb,number,qans:longint;
    a:array[0..10001] of int64;
    b,c:array[0..20] of longint;
    fact:longint;
procedure rec(q:int64);
var i:longint;
begin
 if q<=1000000000 then
  begin
   inc(count);
   a[count]:=q;
  end else
 exit;
 rec(q*10+4);
 rec(q*10+7);
end;

function factor(ver:longint):longint;
var i,ans:longint;
begin
 ans:=1;
 for i:= 1 to ver do
  ans:=ans*i;
 factor:=ans;
end;

function fun(lik:longint):boolean;
var i:longint;
begin
 for i:= 1 to count do
  if a[i]=lik then
   begin
    fun:=true;
    exit;
   end;
 fun:=false;
end;

begin
 count:=0;
 readln(n,m);
 rec(0);
 answer:=0;
 fact:=1;
 num:=0;
 for i:= 1 to n do
  begin
   fact:=fact*i;
   if fact>=m  then
    begin
     num:=i;
     break;
    end;
   if num<>0 then break;
  end;
  if num=0 then begin writeln(-1); halt; end;
  cnt:=0;
  q:=n-num+1;
  for i:= 1 to num do
   begin
    inc(cnt);
    c[cnt]:=q+i-1;
   end;
  qans:=0;
  k:=m;
  for i:= 1 to cnt do
   begin
    t:=factor(num-1);
    if k mod t = 0 then number:=k div t else
    number:=k div t + 1;
    k:= k mod t;
    if k=0 then k:=t;
    inc(qans);
    b[qans]:=c[number];
    for j:= number to num-1 do
     c[j]:=c[j+1];
    c[num]:=0;
    dec(num);
   end;
  otv:=0;
  for i:= 1 to count do
   if a[i]<=q then inc(otv);
  for i:= 1 to cnt do
   if fun(b[i]) and fun(q+i-1) then
   inc(otv);
   writeln(otv-1);
end.

{$mode objfpc}
const
        fi='';
        fo='';
var
        a:array[1..2]of integer=(4,7);
        luckynum:array[0..3000]of int64;
        x,CT:Array[0..13]of integer;
        avail:array[0..13]of boolean;
        c:array[0..13]of int64;
        m,k:int64;
        n:integer;
        res:int64;
        f,g:Text;
        flag:boolean;

procedure       attemp(i:integer;s:int64);
var     j:integer;
begin
        for j:= 1 to 2 do
                begin
                    s:=s*10+a[j];
                    if i=n then begin inc(m);luckynum[m]:=s; end else attemp(i+1,s);
                    s:=s div 10;
                end;
end;

function        find(x:int64):boolean;
var     l,h:integer;
        mid:integer;
begin
 l:=1;h:=m;
 while l<=h do
        begin
            mid:=(l+h) div 2;
            if luckynum[mid]=x then exit(true);
            if luckynum[mid]<x then l:=mid+1 else h:=mid-1;
        end;
  result:=false;
end;

procedure       solve;
var     i,j:integer;
        kt:integer;
begin
        m:=0;res:=0;
        for n:=1 to 10 do attemp(1,0);
        readln(f,n,k);
        kt:=0; flag:=false;
        if n>13 then
                begin
                   kt:=n-13;
                   For j:=1 to m do
                        if luckynum[j]<=kt then inc(res) else break;
                   n:=13;
                   flag:=true;
                end;
       For i:=1 to n do ct[i]:=kt+i;
       c[0]:=1;
       for i:=1 to n do c[i]:=c[i-1]*i;
       flag:=flag or (ct[n]>=k);
       fillchar(avail,sizeof(avail),true);
       for i:=1 to n do
           begin
             for j:=1 to n do
             if avail[j] then
                     if (k>c[n-i]) then dec(k,c[n-i]) else break;
             x[i]:=j;avail[j]:=false;
          end;
       For i:=1 to n do
        begin
            if find(ct[x[i]]) and (find(i+kt)) then inc(res);
        end;
end;

procedure       openf;
begin
    assign(f,fi);reset(f);
    assign(g,fo);rewrite(g);
end;

procedure       closef;
begin
   close(f);close(g);
end;

procedure       print;
begin
  if flag then writeln(g,res) else writeln(g,'-1');
end;

begin
     openf;
     solve;
     print;
     closef;
end.

{$mode objfpc}
const
        fi='';
        fo='';
var
        a:array[1..2]of integer=(4,7);
        luckynum:array[0..3000]of int64;
        x,CT:Array[0..13]of integer;
        avail:array[0..13]of boolean;
        c:array[0..13]of int64;
        m,k:int64;
        n:integer;
        res:int64;
        f,g:Text;

procedure       attemp(i:integer;s:int64);
var     j:integer;
begin
        for j:= 1 to 2 do
                begin
                    s:=s*10+a[j];
                    if i=n then begin inc(m);luckynum[m]:=s; end else attemp(i+1,s);
                    s:=s div 10;
                end;
end;

function        find(x:int64):boolean;
var     l,h:integer;
        mid:integer;
begin
 l:=1;h:=m;
 while l<=h do
        begin
            mid:=(l+h) div 2;
            if luckynum[mid]=x then exit(true);
            if luckynum[mid]<x then l:=mid+1 else h:=mid-1;
        end;
  result:=false;
end;

procedure       solve;
var     i,j:integer;
        kt:integer;
begin
        m:=0;res:=0;
        for n:=1 to 10 do attemp(1,0);
        readln(f,n,k);
        kt:=0;
        if n>13 then
                begin
                   kt:=n-13;
                   For j:=1 to m do
                        if luckynum[j]<=kt then inc(res) else break;
                   n:=13;
                end;
       For i:=1 to n do ct[i]:=kt+i;
       c[0]:=1;
       for i:=1 to n do c[i]:=c[i-1]*i;
       fillchar(avail,sizeof(avail),true);
       for i:=1 to n do
           begin
             for j:=1 to n do
             if avail[j] then
                     if (k>c[n-i]) then dec(k,c[n-i]) else break;
             x[i]:=j;avail[j]:=false;
          end;
       For i:=1 to n do
        begin
            if find(ct[x[i]]) and (find(i+kt)) then inc(res);
        end;
end;

procedure       openf;
begin
    assign(f,fi);reset(f);
    assign(g,fo);rewrite(g);
end;

procedure       closef;
begin
   close(f);close(g);
end;

procedure       print;
begin
  writeln(g,res);
end;

begin
     openf;
     solve;
     print;
     closef;
end.

{$mode objfpc}
const
        fi='';
        fo='';
var
        a:array[1..2]of integer=(4,7);
        luckynum:array[0..3000]of int64;
        x,CT:Array[0..13]of integer;
        avail:array[0..13]of boolean;
        c:array[0..13]of int64;
        m,k:int64;
        n:integer;
        res:int64;
        f,g:Text;

procedure       attemp(i:integer;s:int64);
var     j:integer;
begin
        for j:= 1 to 2 do
                begin
                    s:=s*10+a[j];
                    if i=n then begin inc(m);luckynum[m]:=s; end else attemp(i+1,s);
                    s:=s div 10;
                end;
end;

function        find(x:int64):boolean;
var     l,h:integer;
        mid:integer;
begin
 l:=1;h:=m;
 while l<=h do
        begin
            mid:=(l+h) div 2;
            if luckynum[mid]=x then exit(true);
            if luckynum[mid]<x then l:=mid+1 else h:=mid-1;
        end;
  result:=false;
end;

procedure       solve;
var     i,j:integer;
        kt:integer;
begin
        m:=0;res:=0;
        for n:=1 to 10 do attemp(1,0);
        readln(f,n,k);
        kt:=0;
        if n>13 then
                begin
                   kt:=n-13;
                   For j:=1 to m do
                        if luckynum[j]<=kt then inc(res) else break;
                   n:=13;
                end;
       For i:=1 to n do ct[i]:=kt+i;
       c[0]:=1;
       for i:=1 to n do c[i]:=c[i-1]*i;
       fillchar(avail,sizeof(avail),true);
       for i:=1 to n do
           begin
             for j:=1 to n do
             if avail[j] then
                     if (k>c[n-i]) then dec(k,c[n-i]) else break;
             x[i]:=j;avail[j]:=false;
          end;
       For i:=1 to n do
        begin
            if find(ct[x[i]]) and (find(i+kt)) then inc(res);
        end;
end;

procedure       openf;
begin
    assign(f,fi);reset(f);
    assign(g,fo);rewrite(g);
end;

procedure       closef;
begin
   close(f);close(g);
end;

procedure       print;
begin
     if res=0 then writeln(g,-1) else writeln(g,res);
end;

begin
     openf;
     solve;
     print;
     closef;
end.

var b:array[0..10] of longint;
    a:array[0..100000] of longint;
    i,o,s,j,n,k,c,e,sum,sc:longint;
    fact:array[0..15] of int64;
    use,ans:array[0..20] of longint;

function lucky(s:longint):boolean;
  begin
    while s>0 do
      begin
        if (s mod 10<>4) and (s mod 10<>7) then exit(false);
        s:=s div 10;
      end;
    exit(true);
  end;

begin
  o:=0;
  for i:=1 to 9 do
    begin
      fillchar(b,sizeof(b),0);
      while b[0]=0 do
        begin
          s:=0;
          for j:=1 to i do
            if b[j]=0 then s:=s*10+4 else s:=s*10+7;
          inc(o);
          a[o]:=s;
          j:=i;
          while b[j]=1 do
            begin
              b[j]:=0;
              dec(j);
            end;
          inc(b[j]);
        end;
    end;
  //for i:=1 to o do writeln(a[i]);
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=int64(fact[i-1])*i;
  if n<=15 then
    begin
      dec(k);
      fillchar(use,sizeof(use),0);
      for i:=1 to n do
        begin
          c:=k div fact[n-i]+1;
          k:=k mod fact[n-i];
          e:=0;
          for j:=1 to n do
            if use[j]=0 then
              begin
                inc(e);
                if e=c then
                  begin
                    ans[i]:=j;
                    use[j]:=1;
                    break;
                  end;
              end;
        end;
      //for i:=1 to n do write(ans[i],' ');writeln;
      sum:=0;
      for i:=1 to n do
        if lucky(i) and lucky(ans[i]) then inc(sum);
      writeln(sum);
    end
  else
    begin
      sc:=n-15;
      n:=15;
      dec(k);
      fillchar(use,sizeof(use),0);
      for i:=1 to n do
        begin
          c:=k div fact[n-i]+1;
          k:=k mod fact[n-i];
          e:=0;
          for j:=1 to n do
            if use[j]=0 then
              begin
                inc(e);
                if e=c then
                  begin
                    ans[i]:=j;
                    use[j]:=1;
                    break;
                  end;
              end;
        end;
      //for i:=1 to n do write(ans[i],' ');writeln;
      sum:=0;
      for i:=1 to o do
        if a[i]<=sc then inc(sum);
      for i:=1 to n do
        if lucky(i+sc) and lucky(ans[i]+sc) then inc(sum);
      writeln(sum);
    end;
end.

uses math;
const
      oo=high(longint);
      _oo=high(int64);
      roo=1e30;
      dx:array[0..7] of longint=(-1,0,1,0,-1,1,1,-1);
      dy:array[0..7] of longint=(0,1,0,-1,1,1,-1,-1);
      hs=13;
type point=record x,y:longint; end;
     rpoint=record x,y:double; end;
var f,g:text;
    fi,fo:string;
    a:array[0..111111] of int64;
    gt,num:array[0..33] of int64;
    fr:array[0..33] of boolean;
    nluc,n,i,j,last,nho,nn,ans:longint;
    be,k:int64;
procedure closefile; begin close(g); close(F); end;
//-----------------
procedure sort(l,r:longint);
var i,j:longint;
    m,tmp:int64;
begin
        if l>=r then exit;
        i:=l; j:=r; m:=a[l+random(r-l+1)];
        repeat
               while a[i]<m do inc(i);
               while a[j]>m do dec(j);
               if i<=j then begin
                   tmp:=a[i]; a[i]:=a[j]; a[j]:=tmp;
                   inc(i);
                   dec(j);
               end;
        until i>J;
        sort(i,r);
        sort(l,j);
end;
procedure gen;
var i,j,k:Longint;
begin

                for i:=1 to 11 do
                 for j:=0 to 1<<i-1 do begin
                     inc(nluc);
                     for k:=0 to i-1 do
                      if (j>>k) and 1=0 then a[nluc]:=a[nluc]*10+4
                      else a[nluc]:=a[n]*10+7;
                 end;
                sort(1,nluc);
end;
//---------------------
function isluck(u:longint):boolean;
var s:string;
    i:longint;
begin
        str(u,s);
        for i:=1 to length(s) do
         if (s[i]<>'4') and (s[i]<>'7') then exit(false);
        isluck:=true;
end;
begin
        gen;

        randomize;
       // {$IFNDEF ONLINE_JUDGE} fi := 'i.inp'; fo := ''; {$ENDIF}
        assign(f,fi); reset(f);
        assign(g,fo); rewrite(g);
                readln(f,n,k);
                gt[0]:=1;
                for i:=1 to 12 do gt[i]:=gt[i-1]*i;
                gt[13]:=oo;
                nn:=min(n,hs);
                if n>hs then be:=n-hs
                else be:=0;
                ans:=0;
                if n>hs then begin
                 for i:=1 to nluc do
                  if a[i]>n-hs then break;
                 ans:=i-1;
                end;
                if (n<=hs) and (k>gt[n]) then begin
                    writeln(g,-1);
                    closefile;
                    halt;
                end;
                //
                    for i:=1 to nn do fr[i]:=true;
                    for i:=1 to nn-1 do begin
                      nho:=0; last:=0;
                      for j:=1 to nn do
                       if (nho*gt[nn-i]>=k) then break
                       else if fr[j] then begin
                           inc(nho);
                           last:=j;
                       end;

                      dec(k,(nho-1)*gt[nn-i]);
                      num[i]:=last;
                      fr[last]:=false;
                    end;
                    for i:=1 to nn do
                     if fr[i] then num[nn]:=i;
                    for i:=1 to nn do
                     if isluck(i+be) and isluck(num[i]+be) then inc(ans);
                //
                writeln(g,ans);
        closefile;
end.

uses math;
const
      oo=high(longint);
      _oo=high(int64);
      roo=1e30;
      dx:array[0..7] of longint=(-1,0,1,0,-1,1,1,-1);
      dy:array[0..7] of longint=(0,1,0,-1,1,1,-1,-1);
type point=record x,y:longint; end;
     rpoint=record x,y:double; end;
var f,g:text;
    fi,fo:string;
    a:array[0..111111] of int64;
    gt,num:array[0..13] of int64;
    fr:array[0..13] of boolean;
    nluc,n,i,j,last,nho,nn,ans:longint;
    be,k:int64;
procedure closefile; begin close(g); close(F); end;
//-----------------
procedure sort(l,r:longint);
var i,j:longint;
    m,tmp:int64;
begin
        if l>=r then exit;
        i:=l; j:=r; m:=a[l+random(r-l+1)];
        repeat
               while a[i]<m do inc(i);
               while a[j]>m do dec(j);
               if i<=j then begin
                   tmp:=a[i]; a[i]:=a[j]; a[j]:=tmp;
                   inc(i);
                   dec(j);
               end;
        until i>J;
        sort(i,r);
        sort(l,j);
end;
procedure gen;
var i,j,k:Longint;
begin

                for i:=1 to 11 do
                 for j:=0 to 1<<i-1 do begin
                     inc(nluc);
                     for k:=0 to i-1 do
                      if (j>>k) and 1=0 then a[nluc]:=a[nluc]*10+4
                      else a[nluc]:=a[n]*10+7;
                 end;
                sort(1,nluc);
end;
//---------------------
function isluck(u:longint):boolean;
var s:string;
    i:longint;
begin
        str(u,s);
        for i:=1 to length(s) do
         if (s[i]<>'4') and (s[i]<>'7') then exit(false);
        isluck:=true;
end;
begin
        gen;
        randomize;
       // {$IFNDEF ONLINE_JUDGE} fi := 'i.inp'; fo := ''; {$ENDIF}
        assign(f,fi); reset(f);
        assign(g,fo); rewrite(g);
                readln(f,n,k);
                gt[0]:=1;
                for i:=1 to 12 do gt[i]:=gt[i-1]*i;
                gt[13]:=oo;
                nn:=min(n,12);
                if n>12 then be:=n-12
                else be:=0;
                ans:=0;
                if n>12 then begin
                 for i:=1 to nluc do
                  if a[i]>n-12 then break;
                 ans:=i-1;
                end;
                //
                    for i:=1 to nn do fr[i]:=true;
                    for i:=1 to nn-1 do begin
                      nho:=0; last:=0;
                      for j:=1 to nn do
                       if (nho*gt[nn-i]>=k) then break
                       else if fr[j] then begin
                           inc(nho);
                           last:=j;
                       end;

                      dec(k,(nho-1)*gt[nn-i]);
                      num[i]:=last;
                      fr[last]:=false;
                    end;
                    for i:=1 to nn do
                     if fr[i] then num[nn]:=i;
                    for i:=1 to nn do
                     if isluck(i+be) and isluck(num[i]+be) then inc(ans);
                //
                writeln(g,ans);
        closefile;
end.

uses math;
const
      oo=high(longint);
      _oo=high(int64);
      roo=1e30;
      dx:array[0..7] of longint=(-1,0,1,0,-1,1,1,-1);
      dy:array[0..7] of longint=(0,1,0,-1,1,1,-1,-1);
      hs=13;
type point=record x,y:longint; end;
     rpoint=record x,y:double; end;
var f,g:text;
    fi,fo:string;
    a:array[0..111111] of int64;
    gt,num:array[0..33] of int64;
    fr:array[0..33] of boolean;
    nluc,n,i,j,last,nn,ans:longint;
    be,k,nho:int64;
procedure closefile; begin close(g); close(F); end;
//-----------------
procedure sort(l,r:longint);
var i,j:longint;
    m,tmp:int64;
begin
        if l>=r then exit;
        i:=l; j:=r; m:=a[l+random(r-l+1)];
        repeat
               while a[i]<m do inc(i);
               while a[j]>m do dec(j);
               if i<=j then begin
                   tmp:=a[i]; a[i]:=a[j]; a[j]:=tmp;
                   inc(i);
                   dec(j);
               end;
        until i>J;
        sort(i,r);
        sort(l,j);
end;
procedure gen;
var i,j,k:Longint;
begin

                for i:=1 to 11 do
                 for j:=0 to 1<<i-1 do begin
                     inc(nluc);
                     for k:=0 to i-1 do
                      if (j>>k) and 1=0 then a[nluc]:=a[nluc]*10+4
                      else a[nluc]:=a[n]*10+7;
                 end;
                sort(1,nluc);
end;
//---------------------
function isluck(u:longint):boolean;
var s:string;
    i:longint;
begin
        str(u,s);
        for i:=1 to length(s) do
         if (s[i]<>'4') and (s[i]<>'7') then exit(false);
        isluck:=true;
end;
begin
        gen;
        randomize;
       // {$IFNDEF ONLINE_JUDGE} fi := 'i.inp'; fo := ''; {$ENDIF}
        assign(f,fi); reset(f);
        assign(g,fo); rewrite(g);
                readln(f,n,k);
                gt[0]:=1;
                for i:=1 to 12 do gt[i]:=gt[i-1]*i;
                gt[13]:=oo;
                nn:=min(n,hs);
                if n>hs then be:=n-hs
                else be:=0;
                ans:=0;
                if n>hs then begin
                 for i:=1 to nluc do
                  if a[i]>n-hs then break;
                 ans:=i-1;
                end;
                //
                    for i:=1 to nn do fr[i]:=true;
                    for i:=1 to nn-1 do begin
                      nho:=0; last:=0;
                      for j:=1 to nn do
                       if (nho*gt[nn-i]>=k) then break
                       else if fr[j] then begin
                           inc(nho);
                           last:=j;
                       end;

                      dec(k,(nho-1)*gt[nn-i]);
                      num[i]:=last;
                      fr[last]:=false;
                    end;
                    for i:=1 to nn do
                     if fr[i] then num[nn]:=i;
                    for i:=1 to nn do
                     if isluck(i+be) and isluck(num[i]+be) then inc(ans);
                //
                writeln(g,ans);
        closefile;
end.

{$APPTYPE CONSOLE}
{$maxstacksize 2000000}
var
 ans,nb,l,q,j,add,n,k,i:integer;
 fc:int64;
 a:array[1..15] of integer;
 us:array[1..15] of boolean;

 Function lucky(n:integer):boolean;
 var
  b:boolean;
 begin
  b:=true;

  while (n>0) and (b) do
  begin
   b:=(n mod 10=7) or (n mod 10=4);
   n:=n div 10;
  end;

  lucky:=b;
 end;

 Procedure gen(cur:int64);
  begin
    If cur>add then exit;
    If cur>0 then inc(ans);
    gen(cur*10+4);
    gen(cur*10+7);
  end;

begin
 {reset(input,'Input.txt');
 rewrite(output,'Output.txt'); }
 readln(n,k);

 fc:=1;
 i:=1;

 while (fc<k) and (i<n) do
 begin
  inc(i);
  fc:=fc*i;
 end;

 If fc<k then writeln(-1) else
 begin
  add:=n-i;
  Fillchar(us,sizeof(us),0);

  For j:=1 to i do
  begin
   fc:=fc div (i-j+1);
   q:=k div fc;
   If k mod fc=0 then dec(q);
   inc(q);
   nb:=0;
   For l:=1 to i do If not us[l] then
   begin
    inc(nb);
    If nb=q then
    begin
     us[l]:=true;
     a[j]:=l;
     break;
    end;
   end;
   k:=k-(q-1)*fc;
  end;

  For j:=1 to i do a[i]:=a[i]+add;
  ans:=0;

  For j:=1 to i do If (lucky(add+j)) and (lucky(a[i])) then inc(ans);

  gen(0);

  writeln(ans);
 end;

end.

Uses SysUtils;
Var
   r:Array[1..10000] of Int64;
   a,b,f:Array[0..30] of Int64;
   n,k,t,w,m,kol,p,v:Int64;
   i,j,l,f1,f2:Integer;
Function Max(x,y:Int64):Int64;
Begin
   If x>y Then Max:=x
          Else Max:=y;
End;
Procedure Get(x:Int64);
Begin
   If x>1000000000 Then Exit;
   i:=i+1;
   r[i]:=x;
   Get(10*x+4);
   Get(10*x+7);
End;
Begin
   Read(n,k);
   f[0]:=1;
   For i:=1 To 14 Do f[i]:=i*f[i-1];
   If n<14 Then
      If k>f[n] Then Begin
         Write(-1);
         Halt;
      End;
   i:=0;
   Get(4);
   Get(7);
   m:=i;
   For i:=1 To m-1 Do
      For j:=i+1 To m Do
         If r[i]>r[j] Then Begin
            w:=r[i];
            r[i]:=r[j];
            r[j]:=w;
         End;
   kol:=0;
   t:=Max(1,n-12);
   For i:=t To n Do b[i]:=i;
   For i:=1 To m Do Begin
      If r[i]>t Then Break;
      kol:=kol+1;
   End;
   If n>12 Then n:=13;
   p:=n;
   i:=0;
   While True Do Begin
      i:=i+1;
      v:=k div f[n-1];
      If k mod f[n-1]<>0 Then v:=v+1;
      a[i]:=b[v];
      j:=1;
      n:=n-1;
      If n=0 Then Break;
      For l:=1 To n Do Begin
         If b[l]=a[i] Then j:=j+1;
         b[l]:=b[j];
         j:=j+1;
      End;
      k:=k mod f[n];
      If k=0 Then k:=f[n];
   End;
   For i:=t To p Do Begin
      f1:=0;
      f2:=0;
      For j:=1 To m Do Begin
         If r[j]=i Then f1:=1;
         If r[j]=a[i] Then f2:=1;
      End;
      If (f1=1) and (f2=1) Then kol:=kol+1;
   End;
   Write(kol);
End.

Uses SysUtils;
Var
   r:Array[1..10000] of Int64;
   a,b,f:Array[0..30] of Int64;
   n,k,t,w,m,kol,p,v:Int64;
   i,j,l,f1,f2:Integer;
Function Max(x,y:Int64):Int64;
Begin
   If x>y Then Max:=x
          Else Max:=y;
End;
Procedure Get(x:Int64);
Begin
   If x>1000000000 Then Exit;
   i:=i+1;
   r[i]:=x;
   Get(10*x+4);
   Get(10*x+7);
End;
Begin
   Read(n,k);
   If n<14 Then
      If k>f[n] Then Begin
         Write(-1);
         Halt;
      End;
   i:=0;
   Get(4);
   Get(7);
   m:=i;
   For i:=1 To m-1 Do
      For j:=i+1 To m Do
         If r[i]>r[j] Then Begin
            w:=r[i];
            r[i]:=r[j];
            r[j]:=w;
         End;
   kol:=0;
   t:=Max(1,n-12);
   For i:=t To n Do b[i]:=i;
   For i:=1 To m Do Begin
      If r[i]>t Then Break;
      kol:=kol+1;
   End;
   f[0]:=1;
   For i:=1 To 14 Do f[i]:=i*f[i-1];
   If n>12 Then n:=13;
   p:=n;
   i:=0;
   While True Do Begin
      i:=i+1;
      v:=k div f[n-1];
      If k mod f[n-1]<>0 Then v:=v+1;
      a[i]:=b[v];
      j:=1;
      n:=n-1;
      If n=0 Then Break;
      For l:=1 To n Do Begin
         If b[l]=a[i] Then j:=j+1;
         b[l]:=b[j];
         j:=j+1;
      End;
      k:=k mod f[n];
      If k=0 Then k:=f[n];
   End;
   For i:=t To p Do Begin
      f1:=0;
      f2:=0;
      For j:=1 To m Do Begin
         If r[j]=i Then f1:=1;
         If r[j]=a[i] Then f2:=1;
      End;
      If (f1=1) and (f2=1) Then kol:=kol+1;
   End;
   Write(kol);
End.

Uses SysUtils;
Var
   r:Array[1..10000] of Int64;
   a,b,f:Array[0..30] of Int64;
   n,k,t,w,m,kol,p,v,n1:Int64;
   i,j,l,f1,f2:Integer;
Function Max(x,y:Int64):Int64;
Begin
   If x>y Then Max:=x
          Else Max:=y;
End;
Procedure Get(x:Int64);
Begin
   If x>1000000000 Then Exit;
   i:=i+1;
   r[i]:=x;
   Get(10*x+4);
   Get(10*x+7);
End;
Begin
   Read(n,k);
   f[0]:=1;
   For i:=1 To 14 Do f[i]:=i*f[i-1];
   If n<14 Then
      If k>f[n] Then Begin
         Write(-1);
         Halt;
      End;
   i:=0;
   Get(4);
   Get(7);
   m:=i;
   For i:=1 To m-1 Do
      For j:=i+1 To m Do
         If r[i]>r[j] Then Begin
            w:=r[i];
            r[i]:=r[j];
            r[j]:=w;
         End;
   kol:=0;
   t:=Max(1,n-12);
   j:=1;
   n1:=n;
   For i:=t To n Do Begin
      b[j]:=i;
      j:=j+1;
   End;
   For i:=1 To m Do Begin
      If r[i]>=t Then Break;
      kol:=kol+1;
   End;
   If n>12 Then n:=13;
   p:=n;
   i:=0;
   While True Do Begin
      i:=i+1;
      v:=k div f[n-1];
      If k mod f[n-1]<>0 Then v:=v+1;
      a[i]:=b[v];
      j:=1;
      n:=n-1;
      If n=0 Then Break;
      For l:=1 To n Do Begin
         If b[l]=a[i] Then j:=j+1;
         b[l]:=b[j];
         j:=j+1;
      End;
      k:=k mod f[n];
      If k=0 Then k:=f[n];
   End;
   If p<13 Then p:=0;
   l:=n1-12;
   For i:=1 To p Do Begin
      f1:=0;
      f2:=0;
      For j:=1 To m Do Begin
         If r[j]=l Then f1:=1;
         If r[j]=a[i] Then f2:=1;
      End;
      If (f1=1) and (f2=1) Then kol:=kol+1;
      l:=l+1;
   End;
   Write(kol);
End.

{$APPTYPE CONSOLE}
{$O-,Q-,R-,S+}
uses
  SysUtils, Math;
var
  a, mas, pf, good : array [1..20]of Int64;
  i, j, k, n : int64;
  q, ans, lg, ll, l : longint;
  s : string;
function next(n : int64) : int64;
var
  i, j : LongInt;
begin
  s := '';
  while n > 0 do
    begin
      s := chr(n mod 10 + 48) + s;
      n := n div 10;
    end;
  i := Length(s);
  while (i > 0) and (s[i] = '7') do
    Dec(i);
  if i = 0 then
    begin
      for i := 1 to Length(s) do
        s[i] := '4';
      result := strtoint64(s + '4');
    end
  else
    begin
      s[i] := '7';
      for j := i + 1 to Length(s) do
        s[j] := '4';
      result := strtoint64(s);
    end;
end;
function fack(n : int64) : int64;
var
  i : longint;
  j : Int64;
begin
  if n > 12 then
    n := 12;
  result := 1;
  for i := 2 to n do
    begin
      j := i;
      result := result * j;
    end;
end;
begin
//  reset(input, 'input.txt');
//  rewrite(output, 'output.txt');
  Readln(n, k);
  ans := 0;
  if fack(n) < k then
    begin
      writeln(-1);
      exit;
    end;
  if n > 12 then begin
  q := n - 12;
  ans := 0;
  i := 4;
    while i <= q do
    begin
      Inc(ans);
      i := Next(i);
    end;
  if i > n then
    begin
      writeln(ans);
      exit;
    end;
   good[1] := 12 - (n - i);
   pf[1] := i;
   if next(i) <= n then
     begin
       good[2] := 12 - (n - next(i));
       pf[2] := next(i);
       lg := 2;
     end
   else
     lg := 1;
   for q := n - 11 to n do
     a[q - (n - 11) + 1] := q;
   n := 12;
  end
  else
    begin
      for q := 1 to n do
        a[q] := q;
      if n > 6 then
        begin
          lg := 2;
          good[2] := 7;
          pf[2] := 7;
          good[1] := 4;
          pf[1] := 4;
        end
      else
        if n > 3 then
          begin
            lg := 1;
            good[1] := 4;
            pf[1] := 4;
          end
        else
          begin
            Writeln(0);
            Exit;
          end;
    end;
  ll := n;
  Dec(k);
  for q := n - 1 downto 1 do
    begin
      j := q;
      i := 0;
      while i * fack(j) <= k do
        Inc(i);
      Dec(i);
      mas[n - q] := a[i + 1];
      k := k - i * fack(j);
      for l := i + 1 to ll do
        a[l] := a[l + 1];
      Dec(ll);
    end;
  mas[n] := a[1];
  for l := 1 to lg do
    if mas[good[l]] = pf[l] then
      Inc(ans);
  Writeln(ans);
end.

{$APPTYPE CONSOLE}
{$O-,Q-,R-,S+}
uses
  SysUtils, Math;
var
  a, mas, pf, good : array [1..20]of Int64;
  i, j, k, n : int64;
  q, ans, lg, ll, l : longint;
  s : string;
function next(n : int64) : int64;
var
  i, j : LongInt;
begin
  s := '';
  while n > 0 do
    begin
      s := chr(n mod 10 + 48) + s;
      n := n div 10;
    end;
  i := Length(s);
  while (i > 0) and (s[i] = '7') do
    Dec(i);
  if i = 0 then
    begin
      for i := 1 to Length(s) do
        s[i] := '4';
      result := strtoint64(s + '4');
    end
  else
    begin
      s[i] := '7';
      for j := i + 1 to Length(s) do
        s[j] := '4';
      result := strtoint64(s);
    end;
end;
function fack(n : int64) : int64;
var
  i : longint;
  j : Int64;
begin
  if n > 13 then
    n := 13;
  result := 1;
  for i := 2 to n do
    begin
      j := i;
      result := result * j;
    end;
end;
begin
//  reset(input, 'input.txt');
//  rewrite(output, 'output.txt');
  Readln(n, k);
  ans := 0;
  if fack(n) < k then
    begin
      writeln(-1);
      exit;
    end;
  if n > 13 then begin
  q := n - 13;
  ans := 0;
  i := 4;
    while i <= q do
    begin
      Inc(ans);
      i := Next(i);
    end;
  if i > n then
    begin
      writeln(ans);
      exit;
    end;
   good[1] := 13 - (n - i);
   pf[1] := i;
   if next(i) <= n then
     begin
       good[2] := 13 - (n - next(i));
       pf[2] := next(i);
       lg := 2;
     end
   else
     lg := 1;
   for q := n - 12 to n do
     a[q - (n - 12) + 1] := q;
   n := 13;
  end
  else
    begin
      for q := 1 to n do
        a[q] := q;
      if n > 6 then
        begin
          lg := 2;
          good[2] := 7;
          pf[2] := 7;
          good[1] := 4;
          pf[1] := 4;
        end
      else
        if n > 3 then
          begin
            lg := 1;
            good[1] := 4;
            pf[1] := 4;
          end
        else
          begin
            Writeln(0);
            Exit;
          end;
    end;
  ll := n;
  Dec(k);
  for q := n - 1 downto 1 do
    begin
      j := q;
      i := 0;
      while i * fack(j) <= k do
        Inc(i);
      Dec(i);
      mas[n - q] := a[i + 1];
      k := k - i * fack(j);
      for l := i + 1 to ll do
        a[l] := a[l + 1];
      Dec(ll);
    end;
  mas[n] := a[1];
  for l := 1 to lg do
    if mas[good[l]] = pf[l] then
      Inc(ans);
  Writeln(ans);
end.

{$R+,I+,S+,O+,O-}
Uses Math;
type
	int = longint;
	bool = boolean;
const
	inf = maxint;
var
	n, i, ok1, ok2, u, len, ans, sz, j, m, k, sum : int;
	p, a, b, c, mult : array [0..2000] of int;
	was : array [0..20] of bool;

procedure findnumbers;
begin
	p[0] := 1; sz := 0;
	for i := 1 to 9 do
		p[i] := p[i-1] * 10;

  for u := 1 to 9 do begin
  	len := 1 shl u - 1;
  	for i := 0 to len do begin
	  	for j := 0 to u-1 do
		  	if (i shr j and 1 = 1) then
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 7
			  else
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 4;
	  end;
    sz := sz + len + 1;
  end;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	findnumbers;
	read(n, k);
	m := min(13, n);
	sum := 0;

	for i := n-m+1 to n do
		c[i-n+m] := i;

	ans := 0;
	mult[0] := 1;

	for i := 1 to m-1 do
		mult[i] := mult[i-1] * i;

	for i := 1 to m do begin
		for j := 1 to m do
			if (not was[j]) then begin
				sum	:= sum + mult[m-i];
				if (sum >= k) then begin
					a[i] := c[j];
					was[j] := true;
					break;
				end;
			end;
		sum := sum - mult[m-i];
	end;

	for i := 1 to sz do
		if (b[i] < n-m+1) then inc(ans);

	for i := 1 to m do begin
    ok1 := 0; ok2 := 0;
		for j := 1 to sz do begin
			if (a[i] = b[j]) then ok1 := 1;
      if (i+n-m = b[j]) then ok2 := 1;
    end;
    if (ok1 + ok2 = 2) then inc(ans);
  end;
	write(ans);
end.

{$R+,I+,S+,O+,O-}
Uses Math;
type
	int = longint;
	bool = boolean;
const
	inf = maxint;
var
	n, i, ok1, ok2, u, len, ans, sz, j, m, k, sum : int;
	p, a, b, c, mult : array [0..2000] of int;
	was : array [0..20] of bool;

procedure findnumbers;
begin
	p[0] := 1; sz := 0;
	for i := 1 to 9 do
		p[i] := p[i-1] * 10;

  for u := 1 to 9 do begin
  	len := 1 shl u - 1;
  	for i := 0 to len do begin
	  	for j := 0 to u-1 do
		  	if (i shr j and 1 = 1) then
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 7
			  else
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 4;
	  end;
    sz := sz + len + 1;
  end;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	findnumbers;
	read(n, k);
	m := min(13, n);
	sum := 0;

	for i := n-m+1 to n do
		c[i-n+m] := i;

	ans := 0;
	mult[0] := 1;

	for i := 1 to m-1 do
		mult[i] := mult[i-1] * i;

	for i := 1 to m do begin
		for j := 1 to m do
			if (not was[j]) then begin
				sum	:= sum + mult[m-i];
				if (sum >= k) then begin
					a[i] := c[j];
					was[j] := true;
					break;
				end;
			end;
		sum := sum - mult[m-i];
	end;

	for i := 1 to sz do
		if (b[i] < n-m+1) then inc(ans);

	for i := 1 to m do begin
    ok1 := 0; ok2 := 0;
		for j := 1 to sz do begin
			if (a[i] = b[j]) then ok1 := 1;
      if (i+n-m = b[j]) then ok2 := 1;
    end;
    if (ok1 + ok2 = 2) then inc(ans);
  end;

  if (ans = 0) then ans := -1;
	write(ans);
end.

{$R+,I+,S+,O+,O-}
Uses Math;
type
	int = longint;
	bool = boolean;
const
	inf = maxint;
var
	n, i, ok1, ok2, u, len, ans, sz, j, m, k, sum : int;
	p, a, b, c, mult : array [0..2000] of int;
	was : array [0..20] of bool;

procedure findnumbers;
begin
	p[0] := 1; sz := 0;
	for i := 1 to 9 do
		p[i] := p[i-1] * 10;

  for u := 1 to 9 do begin
  	len := 1 shl u - 1;
  	for i := 0 to len do begin
	  	for j := 0 to u-1 do
		  	if (i shr j and 1 = 1) then
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 7
			  else
			  	b[sz+i+1] := b[sz+i+1] + p[j] * 4;
	  end;
    sz := sz + len + 1;
  end;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	findnumbers;
	read(n, k);
	m := min(13, n);
	sum := 0;

	for i := n-m+1 to n do
		c[i-n+m] := i;

	ans := 0;
	mult[0] := 1;

	for i := 1 to m-1 do
		mult[i] := mult[i-1] * i;

	for i := 1 to m do begin
		for j := 1 to m do
			if (not was[j]) then begin
				sum	:= sum + mult[m-i];
				if (sum >= k) then begin
					a[i] := c[j];
					was[j] := true;
					break;
				end;
			end;
		sum := sum - mult[m-i];
	end;

	for i := 1 to sz do
		if (b[i] < a[1]) then inc(ans);

	for i := 1 to m do begin
    ok1 := 0; ok2 := 0;
		for j := 1 to sz do begin
			if (a[i] = b[j]) then ok1 := 1;
      if (i+n-m = b[j]) then ok2 := 1;
    end;
    if (ok1 + ok2 = 2) then inc(ans);
  end;
	write(ans);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
	i, p, ans, len, l, u, j, q: longint;
	kol, k, n, t, cur, kl: int64;
	b, f: array [0..20] of int64;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
	i: longint;

begin
	if p > len then begin
		inc(l); a[l] := x;
		exit;
	end;
	for i := 0 to 1 do
		if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
	lucky := false;
	while (x > 0) do begin
		if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
		x := x div 10;
 	end;
 	lucky := true;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	read(n, k); l := 0;
	for len := 1 to 9 do
		go(1, 0);
  	ans := 0;
	for i := 1 to l do
		if (a[i] <= n - 13) then inc(ans);
   	u := min(13, n);
   	for i := 1 to u do
   		b[i] := n - (u - i);
  	f[1] := 1; for i := 2 to 13 do f[i] := f[i - 1] * i;
        if f[u] < k then begin
                write(-1);
                halt;
        end;

        kol := 0;
        while kol < k do begin
                for j := 1 to u - 1 do
                        if kol + f[j + 1] >= k then begin
                                t := b[u - j + 1]; b[u - j + 1] := b[u - j]; b[u - j] := t;
                                if j = 1 then kol := kol + f[j] else kol := kol + f[j] + 1;
                                break;
                        end;
        end;
	for i := 1 to u do
		if (lucky(b[i])) and lucky(n - u + i) then inc(ans);
  	write(ans);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
        sum, i, p, v, ans, len, l, u, j, q, x: longint;
        kol, k, n, t, cur, kl: int64;
        b, f: array [0..20] of int64;
        was: array [0..20] of boolean;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
        i: longint;

begin
        if p > len then begin
                inc(l); a[l] := x;
                exit;
        end;
        for i := 0 to 1 do
                if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
        lucky := false;
        while (x > 0) do begin
                if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
                x := x div 10;
        end;
        lucky := true;
end;

begin
        {$ifndef online_judge}
        reset(input, 'a.in');
        rewrite(output, 'a.out');
        {$endif}
        read(n, k); l := 0;
        for len := 1 to 9 do
                go(1, 0);
        ans := 0;
        for i := 1 to l do
                if (a[i] <= n - 13) then inc(ans);
        u := min(13, n);

        f[0] := 1; for i := 1 to 13 do f[i] := f[i - 1] * i;
        if f[u] < k then begin
                write(-1);
                halt;
        end;

        sum := 0;
        for i := 1 to u do begin
                for j := 1 to u do
                        if not was[j] then begin
                                sum := sum + f[u - i];
                                if sum >= k then begin
                                        was[j] := true;
                                        b[i] := j;
                                        break;
                                end;
                        end;
                sum := sum - f[u - i];
        end;

        for i := 1 to u do
                if (lucky(n - u + i + 1)) and (lucky(n - u + b[i] + 1)) then inc(ans);
        write(ans);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
	i, p, ans, len, l, u, j, q: longint;
	kol, k, n, t, cur, kl: int64;
	b, f: array [0..20] of int64;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
	i: longint;

begin
	if p > len then begin
		inc(l); a[l] := x;
		exit;
	end;
	for i := 0 to 1 do
		if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
	lucky := false;
	while (x > 0) do begin
		if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
		x := x div 10;
 	end;
 	lucky := true;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	read(n, k); l := 0;
	for len := 1 to 9 do
		go(1, 0);
  	ans := 0;
	for i := 1 to l do
		if (a[i] <= n - 13) then inc(ans);
   	u := min(13, n);
   	for i := 1 to u do
   		b[i] := n - (u - i);
  	f[1] := 1; for i := 2 to 13 do f[i] := f[i - 1] * i;
        if f[u] < k then begin
                write(-1);
                halt;
        end;

        kol := 1;
        while kol < k do begin
                for j := 1 to u - 1 do
                        if kol + f[j + 1] > k then begin
                                t := b[u - j + 1]; b[u - j + 1] := b[u - j]; b[u - j] := t;
                                kol := kol + f[j];
                                break;
                        end;{ else
                        if kol + f[j] = k then begin
                                t := b[u - j + 1]; b[u - j + 1] := b[u - j]; b[u - j] := t;
                                kol := k;
                                break;
                        end;   }
        end;
	for i := 1 to u do
		if (lucky(b[i])) and lucky(n - u + i) then inc(ans);
  	write(ans);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
	i, p, ans, len, l, u, j, q: longint;
	kol, k, n, t, cur, kl: int64;
	b, f: array [0..20] of int64;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
	i: longint;

begin
	if p > len then begin
		inc(l); a[l] := x;
		exit;
	end;
	for i := 0 to 1 do
		if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
	lucky := false;
	while (x > 0) do begin
		if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
		x := x div 10;
 	end;
 	lucky := true;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	read(n, k); l := 0;
	for len := 1 to 9 do
		go(1, 0);
  	ans := 0;
	for i := 1 to l do
		if (a[i] <= n - 13) then inc(ans);
   	u := min(13, n);
   	for i := 1 to u do
   		b[i] := n - (u - i);
  	f[1] := 1; for i := 2 to 13 do f[i] := f[i - 1] * i;
        if f[u] < k then begin
                write(-1);
                halt;
        end;

        kol := 1;
        while kol < k do begin
                for j := 1 to u - 1 do
                        if kol + f[j + 1] >= k then begin
                                t := b[u - j + 1]; b[u - j + 1] := b[u - j]; b[u - j] := t;
                                if j = 1 then kol := kol + f[j] else kol := kol + f[j] + 1;
                                break;
                        end;
        end;
	for i := 1 to u do
		if (lucky(b[i])) and lucky(n - u + i) then inc(ans);
  	write(ans);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
	i, p, ans, len, l, u, j: longint;
	kol, k, n, t, cur, kl: int64;
	b, f: array [0..20] of int64;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
	i: longint;

begin
	if p > len then begin
		inc(l); a[l] := x;
		exit;
	end;
	for i := 0 to 1 do
		if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
	lucky := false;
	while (x > 0) do begin
		if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
		x := x div 10;
 	end;
 	lucky := true;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	read(n, k); l := 0;
	for len := 1 to 9 do
		go(1, 0);
  	ans := 0;
	for i := 1 to l do
		if (a[i] <= n - 13) then inc(ans);
   	u := min(13, n);
   	for i := 1 to u do
   		b[i] := n - (u - i);
  	f[1] := 1; for i := 2 to 13 do f[i] := f[i - 1] * i;
                if f[u] < k then begin
                        write(-1);
                        halt;
                end;
    p := u;
    cur := u;
    kol := 0;
    kl := 1;
    while (kol < k) do begin
    	if f[u - p + 2] > k then begin
                kol := kol + kl;
                if kol >= k then break;
       		t := b[p - 1]; b[p - 1] := b[u]; b[u] := t;
                cur := b[p];
                for j := p to p + ((u - p) div 2) do begin
                        t := b[j]; b[j] := b[u - (j - p)]; b[u - (j - p)] := t;
                end;
    		p := u;
    		inc(kol);
       	end else begin
       		kl := f[u - p + 2];
                dec(p);
                for j := p to u - 1 do begin
                        t := b[j]; b[j] := b[j + 1]; b[j + 1] := t;
                end;
	end;
    end;
	for i := 1 to u do
		if (lucky(b[i])) and lucky(n - u + i) then inc(ans);
  	write(ans);
end.

Uses Math;
{$R+,I+,S+,O+,O-}
var
	i, p, ans, len, l, u, j: longint;
	kol, k, n, t, cur, kl: int64;
	b, f: array [0..20] of int64;
        a: array [0..2048] of int64;

Procedure go(p: longint; x: int64);
var
	i: longint;

begin
	if p > len then begin
		inc(l); a[l] := x;
		exit;
	end;
	for i := 0 to 1 do
		if i = 0 then go(p + 1, x * 10 + 4) else go(p + 1, x * 10 + 7);
end;

Function lucky(x: int64): boolean;
begin
	lucky := false;
	while (x > 0) do begin
		if (x mod 10 <> 4) and (x mod 10 <> 7) then exit;
		x := x div 10;
 	end;
 	lucky := true;
end;

begin
	{$ifndef online_judge}
	reset(input, 'a.in');
	rewrite(output, 'a.out');
	{$endif}
	read(n, k); l := 0;
	for len := 1 to 9 do
		go(1, 0);
  	ans := 0;
	for i := 1 to l do
		if (a[i] <= n - 13) then inc(ans);
   	u := min(13, n);
   	for i := 1 to u do
   		b[i] := n - (u - i);
  	f[1] := 1; for i := 2 to 13 do f[i] := f[i - 1] * i;
                if f[u] < k then begin
                        write(-1);
                        halt;
                end;
    p := u;
    cur := u;
    kol := 0;
    kl := 1;
    while (kol < k) do begin
    	if f[u - p + 2] > k then begin
                kol := kol + kl;
                if kol >= k then break;
       		t := b[p - 1]; b[p - 1] := b[u]; b[u] := t;
                cur := b[p];
                for j := p to p + ((u - p) div 2) do begin
                        t := b[j]; b[j] := b[u - (j - p)]; b[u - (j - p)] := t;
                end;
    		p := u;
    		inc(kol);
       	end else begin
       		kl := f[u - p + 2];
                dec(p);
                for j := p to u - 1 do begin
                        t := b[j]; b[j] := b[j + 1]; b[j + 1] := t;
                end;
	end;
    end;
	for i := 1 to u do
		if (lucky(b[i])) and lucky(i) then inc(ans);
  	write(ans);
end.

program Lucky_Transformation;
var
  ls,k,j,i:longint;
  c:string;
  s:array[0..100000] of char;
  c1,c2:ansistring;
begin
  readln(ls,k);
  for i:=1 to ls do read(s[i]);
  for i:=1 to ls-1 do begin
    if (i mod 2=1) and (i+2<=ls) then begin
      c:=s[i]+s[i+1]+s[i+2];
      if c='447' then begin
        c1:='';
        for j:=1 to i-1 do c1:=c1+s[j];
        c2:='';
        for j:=i+3 to ls do c2:=c2+s[j];
        if k mod 2=0 then writeln(c1+'447'+c2)
          else writeln(c1+'477'+c2);
        halt;
      end;
      if c='477' then begin
        c1:='';
        for j:=1 to i-1 do c1:=c1+s[j];
        c2:='';
        for j:=i+3 to ls do c2:=c2+s[j];
        if k mod 2=1 then writeln(c1+'447'+c2)
          else writeln(c1+'477'+c2);
        halt;
      end;
    end;
    if (i mod 2=1) and (s[i]='4') and (s[i+1]='7') then begin
      if k=0 then break;
      s[i+1]:='4';
      dec(k);
    end;
    if (i mod 2=0) and (s[i]='4') and (s[i+1]='7') then begin
      if k=0 then break;
      s[i]:='7';
      dec(k);
    end;
  end;
  for i:=1 to ls do write(s[i]);
  writeln;
end.

const  abc=1000000000000;
var  n,m,p,k:longint;
     s:int64;
     a:array[0..1111]of int64;
     kt:array[0..20]of boolean;
     res:longint;

procedure create(s:string);
var  code:longint;
begin
     if length(s) >9 then exit;
     if s<>'' then
     begin
          inc(m);
          val(s,a[m],code);
     end;
     create(s+'4');
     create(s+'7');
end;

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

procedure check;
var  i:longint;
begin
     s:=1;
     p:=0;
     for i:=1 to n do
     if s*i>abc then break
     else
     begin
          inc(p);
          s:=s*i;
     end;

     if k>s then
     begin
          writeln(-1);
          halt;
     end;
end;

function chk(x:longint):boolean;
var  s:string;
     i:longint;
begin
     str(x,s);
     if s='' then exit(false);
     for i:=1 to length(s) do
     if (s[i]<>'4') and (s[i]<>'7') then exit(false);
     exit(true);
end;

procedure timhoanvi;
var  i,j,t,count:longint;
begin
     for i:=1 to p do
     begin
          s:=s div (p-i+1);

          t:=(k+s-1) div s;
          k:=k-(t-1)*s;
          count:=0;
          for j:=1 to p do
          if kt[j]=false then
          begin
               inc(count);
               if count=t then break;
          end;

          kt[j]:=true;

          if chk(n-p+i) and chk(j) then inc(res);
     end;
end;

procedure tinh;
var  i:longint;
begin
     res:=0;
     for i:=1 to m do
     if a[i]<=n-p then inc(res)
     else break;

     timhoanvi;
end;

begin
     readln(n,k);
     check;
     m:=0;
     create('');
     sort(1,m);
     tinh;
     writeln(res);
end.

const
        fi='';
var
        f:Text;
        k,kq,m:longint;
        g:array [1..13,1..13] of longint;
        kt:array [1..13] of boolean;
        a,v,b:array [1..13] of longint;
        d:array [1..10] of boolean;
        lucky:array [1..2046]  of int64;
        n:int64;
procedure nhap;
begin
        assign(f,fi);
        reset(f);
        readln(f,n,k);
        close(f);
end;
function ck(u:longint):boolean;
var
        x:longint;
begin
        x:=u;
        while x>0 do
        begin
                if (x mod 10<>4) and (x mod 10<>7) then exit(false);
                x:=x div 10;
        end;
        exit(true);
end;
procedure cb;
var
        i,j,u:longint;
begin
        g[1,1]:=1;
        g[2,1]:=1; g[2,2]:=1; u:=2;
        for i:=3 to 13 do
        begin
                for j:=1 to i do g[i,j]:=g[i-1,j]*u;
                g[i,i]:=g[i,i-1];
                inc(u);
        end;
end;
procedure lam1;
var
        i,j,u,s,d,o:longint;
begin
        u:=n; fillchar(kt,sizeof(kt),true);
        for i:=n downto 1 do
        begin
                s:=0; d:=0; o:=1;
                for j:=1 to i do
                begin
                        s:=s+g[i,j]; inc(d);
                        if s>=k then
                        begin
                                s:=s-g[i,j]; dec(d);
                                k:=k-s;
                                o:=0;
                                break;
                        end;
                end;
                if o=1 then
                begin
                        writeln(-1);
                        halt;
                end;
                s:=0;
                for j:=1 to n do
                if kt[j] then
                begin
                        inc(s);
                        if s>d then
                        begin
                                a[n-i+1]:=j;
                                kt[j]:=false;
                                break;
                        end;
                end;
        end;
        kq:=0;
        for i:=1 to n do
        if (ck(i)) and (ck(a[i])) then inc(kq);
        writeln(kq);
end;
procedure sinh(u,le:longint);
    var
            i:longint;
            so:int64;
    begin
            if u>le then
            begin
                    so:=0;
                    for i:=1 to le do
                    begin
                            so:=so*10;
                            if d[i] then so:=so+4
                            else so:=so+7;
                    end;
                    inc(m);
                    lucky[m]:=so;
            end
            else
            begin
                    d[u]:=true;
                    sinh(u+1,le);
                    d[u]:=false;
                    sinh(u+1,le);
            end;
    end;
    procedure quicksort(l,r:longint);
    var
            i,j:longint;
            p,t:int64;
    begin
            if l>=r then exit;
            i:=l; j:=r;
            p:=lucky[(i+j) div 2];
            repeat
                    while lucky[i]<p do inc(i);
                    while lucky[j]>p do dec(j);
                    if i<=j then
                    begin
                            t:=lucky[i]; lucky[i]:=lucky[j]; lucky[j]:=t;
                            inc(i); dec(j);
                    end;
            until i>=j;
            quicksort(l,j);
            quicksort(i,r);
    end;
    procedure tao;
    var
            i:longint;
    begin
            m:=0;
            for i:=1 to 10 do
            begin
                    fillchar(d,sizeof(d),true);
                    sinh(1,i);
            end;
            quicksort(1,m);
    end;
procedure lam2;
var
        i,j,u,s,d,o:longint;
begin
        u:=n; fillchar(kt,sizeof(kt),true);
        for i:=13 downto 1 do
        begin
                s:=0; d:=0;  o:=1;
                for j:=1 to i do
                begin
                        s:=s+g[i,j]; inc(d);
                        if s>=k then
                        begin
                                s:=s-g[i,j]; dec(d);
                                k:=k-s;
                                o:=0;
                                break;
                        end;
                end;
                if o=1 then
                begin
                        writeln(-1);
                        halt;
                end;
                s:=0;
                for j:=1 to 13 do
                if kt[j] then
                begin
                        inc(s);
                        if s>d then
                        begin
                                a[13-i+1]:=j;
                                kt[j]:=false;
                                break;
                        end;
                end;
        end;
        if k>0 then
        begin
                writeln(-1);
                halt;
        end;
        for i:=1 to 13 do v[i]:=n-13+i;
        for i:=1 to 13 do b[i]:=n-13+a[i];
        tao;
        kq:=0;
        for i:=1 to 2046 do
        begin
                if lucky[i]=n-13 then
                begin
                        kq:=i;
                        break;
                end
                else
                if lucky[i]>n-13 then
                begin
                        kq:=i-1;
                        break;
                end;
        end;
        for i:=1 to 13 do
        if (ck(b[i])) and (ck(v[i])) then inc(kq);
        writeln(kq);
end;
procedure xuly;
begin
        if n<=13 then lam1
        else lam2;
end;
begin
        nhap;
        cb;
        xuly;
end.

const
        fi='';
var
        f:Text;
        k,kq,m:longint;
        g:array [1..13,1..13] of longint;
        kt:array [1..13] of boolean;
        a,v,b:array [1..13] of longint;
        d:array [1..10] of boolean;
        lucky:array [1..2046]  of int64;
        n:int64;
procedure nhap;
begin
        assign(f,fi);
        reset(f);
        readln(f,n,k);
        close(f);
end;
function ck(u:longint):boolean;
var
        x:longint;
begin
        x:=u;
        while x>0 do
        begin
                if (x mod 10<>4) and (x mod 10<>7) then exit(false);
                x:=x div 10;
        end;
        exit(true);
end;
procedure cb;
var
        i,j,u:longint;
begin
        g[1,1]:=1;
        g[2,1]:=1; g[2,2]:=1; u:=2;
        for i:=3 to 13 do
        begin
                for j:=1 to i do g[i,j]:=g[i-1,j]*u;
                g[i,i]:=g[i,i-1];
                inc(u);
        end;
end;
procedure lam1;
var
        i,j,u,s,d:longint;
begin
        u:=n; fillchar(kt,sizeof(kt),true);
        for i:=n downto 1 do
        begin
                s:=0; d:=0;
                for j:=1 to i do
                begin
                        s:=s+g[i,j]; inc(d);
                        if s>=k then
                        begin
                                s:=s-g[i,j]; dec(d);
                                k:=k-s;
                                break;
                        end;
                end;
                s:=0;
                for j:=1 to n do
                if kt[j] then
                begin
                        inc(s);
                        if s>d then
                        begin
                                a[n-i+1]:=j;
                                kt[j]:=false;
                                break;
                        end;
                end;
        end;
        kq:=0;
        for i:=1 to n do
        if (ck(i)) and (ck(a[i])) then inc(kq);
        writeln(kq);
end;
procedure sinh(u,le:longint);
    var
            i:longint;
            so:int64;
    begin
            if u>le then
            begin
                    so:=0;
                    for i:=1 to le do
                    begin
                            so:=so*10;
                            if d[i] then so:=so+4
                            else so:=so+7;
                    end;
                    inc(m);
                    lucky[m]:=so;
            end
            else
            begin
                    d[u]:=true;
                    sinh(u+1,le);
                    d[u]:=false;
                    sinh(u+1,le);
            end;
    end;
    procedure quicksort(l,r:longint);
    var
            i,j:longint;
            p,t:int64;
    begin
            if l>=r then exit;
            i:=l; j:=r;
            p:=lucky[(i+j) div 2];
            repeat
                    while lucky[i]<p do inc(i);
                    while lucky[j]>p do dec(j);
                    if i<=j then
                    begin
                            t:=lucky[i]; lucky[i]:=lucky[j]; lucky[j]:=t;
                            inc(i); dec(j);
                    end;
            until i>=j;
            quicksort(l,j);
            quicksort(i,r);
    end;
    procedure tao;
    var
            i:longint;
    begin
            m:=0;
            for i:=1 to 10 do
            begin
                    fillchar(d,sizeof(d),true);
                    sinh(1,i);
            end;
            quicksort(1,m);
    end;
procedure lam2;
var
        i,j,u,s,d:longint;
begin
        u:=n; fillchar(kt,sizeof(kt),true);
        for i:=13 downto 1 do
        begin
                s:=0; d:=0;
                for j:=1 to i do
                begin
                        s:=s+g[i,j]; inc(d);
                        if s>=k then
                        begin
                                s:=s-g[i,j]; dec(d);
                                k:=k-s;
                                break;
                        end;
                end;
                s:=0;
                for j:=1 to 13 do
                if kt[j] then
                begin
                        inc(s);
                        if s>d then
                        begin
                                a[13-i+1]:=j;
                                kt[j]:=false;
                                break;
                        end;
                end;
        end;
        for i:=1 to 13 do v[i]:=n-13+i;
        for i:=1 to 13 do b[i]:=n-13+a[i];
        tao;
        kq:=0;
        for i:=1 to 2046 do
        begin
                if lucky[i]=n-13 then
                begin
                        kq:=i;
                        break;
                end
                else
                if lucky[i]>n-13 then
                begin
                        kq:=i-1;
                        break;
                end;
        end;
        for i:=1 to 13 do
        if (ck(b[i])) and (ck(v[i])) then inc(kq);
        writeln(kq);
end;
procedure xuly;
begin
        if n<=13 then lam1
        else lam2;
end;
begin
        nhap;
        cb;
        xuly;
end.

{$mode objfpc}
const
       fi = '';
        fo=  '';
        maxN = 10000000;
        nlk = 1023;
var
         n , m,k,count : integer;
         res : int64 ;
         lk,a : array[0..nlk] of int64;
         gt : array[0..30] of int64;
         f : text ;

Procedure enter;
var i : integer;
begin
     assign(f,fi) ; reset(f);
     readln(f,n,m);
     close(F) ;
     gt[1] := 1;
     for i := 2 to 15 do gt[i] := gt[i-1] * i ;
end ;

Procedure cal( i : int64 );

var    x : int64;

begin
       if i >= 10000000000 then exit ;
       inc(n) ;
       lk[n] := i ;
       x:= i ;
       i := x * 10 + 4;
       cal(i) ;
       i := x * 10 + 7;
       cal(i);

end ;

procedure qsort(l,h : integer);
var i , j , pivot : integer;

begin
     if l >= h then exit ;
     i := random( h - l + 1) + l ;
     pivot :=lk[ i] ; lk[i] := lk[l] ;
     i := l ;
     j := h ;
     repeat
                  while (i<j) and (lk[j] > pivot) do dec(j) ;
                  if i < j then begin
                                 lk[i] :=lk[j];
                                 inc(i);
                  end else break;
                  while (i<j ) and (lk[i] < pivot) do inc(i) ;
                  if i < j then begin
                                  lk[j] := lk[i];
                                  dec(j);
                  end else break ;
     until i = j ;
     lk[i] := pivot;
     qsort(l,i-1);
     qsorT(i+1,h) ;
end ;

Procedure process1;
 var
 i ,j , k : integer;
 check : array[0..20] of boolean;
 sum : int64;
  Begin

   j :=  n -1;
   fillchar(check , sizeof(check) , false);
   i :=1;
  repeat
  sum :=0;
  k := 0;
   for i := 1  to n do
    begin
    if not check[i] then

      if (sum < m) then
         begin
        sum := sum + gt[j];
        k := i;
         end
      else break;
    end;
   i := k ;
//   write(f ,i , ' ');
inc(count) ;
a[ count ] := i ;
   Check[i ] := true;
   dec(j);
   m := m -sum + gt[j + 1];
  until j <= 0;

  for i := 1 to n do if not check[i] then begin
     inc(count) ;
       a[count] := i ;
       end ;

   ENd;

function ok( x : int64) : boolean ;
var i : integer;
begin
                while x > 0 do
                 begin
                      i := x mod 10 ;
                      if ( i<>4) and ( i<>7) then exit(false);
                      x := x div 10 ;
                 end ;
                 result := true ;
end ;

Procedure process;
var i , j : integer;

begin
     j := n ;
     if n > 15 then n := 15;
     if m > gt[n] then begin
          writeln(-1) ;
          halt ;
     end ;
     process1;
     for i := 1 to n do inc(a[i], n - 15 ) ;
     for i := 1 to n do
      if ok(i) and ok(a[i]) then inc(res) ;

     n := j;
     for i := 1 to nlk do if lk[i] > n - 15 then break ;
     inc(res,i-1) ;
//     if res = 0 then res := -1;
     writeln(Res);
end ;
begin
     enter;
     process;
end.

{$mode objfpc}
const
        fi = '';
        fo=  '';
        maxN = 10000000;
        nlk = 1023;
var
         n , m,k,count : integer;
         res : int64 ;
         lk,a : array[0..nlk] of int64;
         gt : array[0..14] of int64;
         f : text ;

Procedure enter;
var i : integer;
begin
     assign(f,fi) ; reset(f);
     readln(f,n,m);
     close(F) ;
     gt[1] := 1;
     for i := 2 to 14 do gt[i] := gt[i-1] * i ;
end ;

Procedure cal( i : int64 );

var    x : int64;

begin
       if i >= 10000000000 then exit ;
       inc(n) ;
       lk[n] := i ;
       x:= i ;
       i := x * 10 + 4;
       cal(i) ;
       i := x * 10 + 7;
       cal(i);

end ;

procedure qsort(l,h : integer);
var i , j , pivot : integer;

begin
     if l >= h then exit ;
     i := random( h - l + 1) + l ;
     pivot :=lk[ i] ; lk[i] := lk[l] ;
     i := l ;
     j := h ;
     repeat
                  while (i<j) and (lk[j] > pivot) do dec(j) ;
                  if i < j then begin
                                 lk[i] :=lk[j];
                                 inc(i);
                  end else break;
                  while (i<j ) and (lk[i] < pivot) do inc(i) ;
                  if i < j then begin
                                  lk[j] := lk[i];
                                  dec(j);
                  end else break ;
     until i = j ;
     lk[i] := pivot;
     qsort(l,i-1);
     qsorT(i+1,h) ;
end ;

Procedure process1;
 var
 i ,j , k : integer;
 check : array[0..20] of boolean;
 sum : int64;
  Begin

   j :=  n -1;
   fillchar(check , sizeof(check) , false);
   i :=1;
  repeat
  sum :=0;
  k := 0;
   for i := 1  to n do
    begin
    if not check[i] then

      if (sum < m) then
         begin
        sum := sum + gt[j];
        k := i;
         end
      else break;
    end;
   i := k ;
//   write(f ,i , ' ');
inc(count) ;
a[ count ] := i ;
   Check[i ] := true;
   dec(j);
   m := m -sum + gt[j + 1];
  until j <= 0;

  for i := 1 to n do if not check[i] then begin
     inc(count) ;
       a[count] := i ;
       end ;

   ENd;

function ok( x : int64) : boolean ;
var i : integer;
begin
                while x > 0 do
                 begin
                      i := x mod 10 ;
                      if ( i<>4) and ( i<>7) then exit(false);
                      x := x div 10 ;
                 end ;
                 result := true ;
end ;

Procedure process;
var i , j : integer;

begin
     j := n ;
     if n > 14 then n := 14 ;
     if k > gt[n] then begin
          writeln(-1) ;
          halt ;
     end ;
     process1;
     for i := 1 to n do
      if ok(i) and ok(a[i]) then inc(res) ;

     n := j ;
     for i := 1 to nlk do if lk[i] > n then break ;
     inc(res,nlk-i) ;
     if res = 0 then res := -1;
     writeln(Res);
end ;
begin
     enter;
     process;
end.

{$mode objfpc}
const
        fi = '';
        fo=  '';
        maxN = 10000000;
        nlk = 1023;
var
         n , m,k,count : integer;
         res : int64 ;
         lk,a : array[0..nlk] of int64;
         gt : array[0..14] of int64;
         f : text ;

Procedure enter;
var i : integer;
begin
     assign(f,fi) ; reset(f);
     readln(f,n,m);
     close(F) ;
     gt[1] := 1;
     for i := 2 to 14 do gt[i] := gt[i-1] * i ;
end ;

Procedure cal( i : int64 );

var    x : int64;

begin
       if i >= 10000000000 then exit ;
       inc(n) ;
       lk[n] := i ;
       x:= i ;
       i := x * 10 + 4;
       cal(i) ;
       i := x * 10 + 7;
       cal(i);

end ;

procedure qsort(l,h : integer);
var i , j , pivot : integer;

begin
     if l >= h then exit ;
     i := random( h - l + 1) + l ;
     pivot :=lk[ i] ; lk[i] := lk[l] ;
     i := l ;
     j := h ;
     repeat
                  while (i<j) and (lk[j] > pivot) do dec(j) ;
                  if i < j then begin
                                 lk[i] :=lk[j];
                                 inc(i);
                  end else break;
                  while (i<j ) and (lk[i] < pivot) do inc(i) ;
                  if i < j then begin
                                  lk[j] := lk[i];
                                  dec(j);
                  end else break ;
     until i = j ;
     lk[i] := pivot;
     qsort(l,i-1);
     qsorT(i+1,h) ;
end ;

Procedure process1;
 var
 i ,j , k : integer;
 check : array[0..20] of boolean;
 sum : int64;
  Begin

   j :=  n -1;
   fillchar(check , sizeof(check) , false);
   i :=1;
  repeat
  sum :=0;
  k := 0;
   for i := 1  to n do
    begin
    if not check[i] then

      if (sum < m) then
         begin
        sum := sum + gt[j];
        k := i;
         end
      else break;
    end;
   i := k ;
//   write(f ,i , ' ');
inc(count) ;
a[ count ] := i ;
   Check[i ] := true;
   dec(j);
   m := m -sum + gt[j + 1];
  until j <= 0;

  for i := 1 to n do if not check[i] then begin
     inc(count) ;
       a[count] := i ;
       end ;

   ENd;

function ok( x : int64) : boolean ;
var i : integer;
begin
                while x > 0 do
                 begin
                      i := x mod 10 ;
                      if ( i<>4) and ( i<>7) then exit(false);
                      x := x div 10 ;
                 end ;
                 result := true ;
end ;

Procedure process;
var i , j : integer;

begin
     j := n ;
     if n > 14 then n := 14 ;
     process1;
     for i := 1 to n do
      if ok(i) and ok(a[i]) then inc(res) ;

     n := j ;
     for i := 1 to nlk do if lk[i] > n then break ;
     inc(res,nlk-i) ;
     writeln(Res);
end ;
begin
     enter;
     process;
end.

{$mode objfpc}
const
       fi = '';
        fo=  '';
        maxN = 10000000;
        nlk = 1024;
var
         n , m,k,count : integer;
         res : int64 ;
         lk,a : array[0..nlk] of int64;
         gt : array[0..30] of int64;
         f : text ;

Procedure enter;
var i : integer;
begin
     assign(f,fi) ; reset(f);
     readln(f,n,m);
     close(F) ;
     gt[1] := 1;
     for i := 2 to 15 do gt[i] := gt[i-1] * i ;
end ;

Procedure cal( i : int64 );

var    x : int64;

begin
       if i >= 1000000000 then exit ;
       inc(n) ;
       lk[n] := i ;
       x:= i ;
       i := x * 10 + 4;
       cal(i) ;
       i := x * 10 + 7;
       cal(i);

end ;

procedure qsort(l,h : integer);
var i , j , pivot : integer;

begin
     if l >= h then exit ;
     i := random( h - l + 1) + l ;
     pivot :=lk[ i] ; lk[i] := lk[l] ;
     i := l ;
     j := h ;
     repeat
                  while (i<j) and (lk[j] > pivot) do dec(j) ;
                  if i < j then begin
                                 lk[i] :=lk[j];
                                 inc(i);
                  end else break;
                  while (i<j ) and (lk[i] < pivot) do inc(i) ;
                  if i < j then begin
                                  lk[j] := lk[i];
                                  dec(j);
                  end else break ;
     until i = j ;
     lk[i] := pivot;
     qsort(l,i-1);
     qsorT(i+1,h) ;
end ;

Procedure process1;
 var
 i ,j , k : integer;
 check : array[0..20] of boolean;
 sum : int64;
  Begin

   j :=  n -1;
   fillchar(check , sizeof(check) , false);
   i :=1;
  repeat
  sum :=0;
  k := 0;
   for i := 1  to n do
    begin
    if not check[i] then

      if (sum < m) then
         begin
        sum := sum + gt[j];
        k := i;
         end
      else break;
    end;
   i := k ;
//   write(f ,i , ' ');
inc(count) ;
a[ count ] := i ;
   Check[i ] := true;
   dec(j);
   m := m -sum + gt[j + 1];
  until j <= 0;

  for i := 1 to n do if not check[i] then begin
     inc(count) ;
       a[count] := i ;
       end ;

   ENd;

function ok( x : int64) : boolean ;
var i : integer;
begin
                while x > 0 do
                 begin
                      i := x mod 10 ;
                      if ( i<>4) and ( i<>7) then exit(false);
                      x := x div 10 ;
                 end ;
                 result := true ;
end ;

Procedure process;
var i , j , k : integer;

begin
     j := n ;
     k := 0 ;
     if n > 15 then begin
       k := n - 15;
      n := 15;
      end ;

     if m > gt[n] then begin
          writeln(-1) ;
          halt ;
     end ;
     process1;

//     for i := 1 to n do inc(a[i], n  ) ;
     for i := 1 to n do
      if ok(i+k) and ok(a[i]+k) then inc(res) ;

     n := j;
     for i := 1 to nlk do if lk[i] > n - 15 then break ;
     inc(res,i-1) ;
//     if res = 0 then res := -1;
     writeln(Res);
end ;
begin
     cal(0) ;qsort(1,nlk) ;
     enter;

     process;
end.

{$mode objfpc}
const
        fi = '';
        fo=  '';
        maxN = 10000000;
        nlk = 1023;
var
         n , m,k,count : integer;
         res : int64 ;
         lk,a : array[0..nlk] of int64;
         gt : array[0..14] of int64;
         f : text ;

Procedure enter;
var i : integer;
begin
     assign(f,fi) ; reset(f);
     readln(f,n,m);
     close(F) ;
     gt[1] := 1;
     for i := 2 to 14 do gt[i] := gt[i-1] * i ;
end ;

Procedure cal( i : int64 );

var    x : int64;

begin
       if i >= 10000000000 then exit ;
       inc(n) ;
       lk[n] := i ;
       x:= i ;
       i := x * 10 + 4;
       cal(i) ;
       i := x * 10 + 7;
       cal(i);

end ;

procedure qsort(l,h : integer);
var i , j , pivot : integer;

begin
     if l >= h then exit ;
     i := random( h - l + 1) + l ;
     pivot :=lk[ i] ; lk[i] := lk[l] ;
     i := l ;
     j := h ;
     repeat
                  while (i<j) and (lk[j] > pivot) do dec(j) ;
                  if i < j then begin
                                 lk[i] :=lk[j];
                                 inc(i);
                  end else break;
                  while (i<j ) and (lk[i] < pivot) do inc(i) ;
                  if i < j then begin
                                  lk[j] := lk[i];
                                  dec(j);
                  end else break ;
     until i = j ;
     lk[i] := pivot;
     qsort(l,i-1);
     qsorT(i+1,h) ;
end ;

Procedure process1;
 var
 i ,j , k : integer;
 check : array[0..20] of boolean;
 sum : int64;
  Begin

   j :=  n -1;
   fillchar(check , sizeof(check) , false);
   i :=1;
  repeat
  sum :=0;
  k := 0;
   for i := 1  to n do
    begin
    if not check[i] then

      if (sum < m) then
         begin
        sum := sum + gt[j];
        k := i;
         end
      else break;
    end;
   i := k ;
//   write(f ,i , ' ');
inc(count) ;
a[ count ] := i ;
   Check[i ] := true;
   dec(j);
   m := m -sum + gt[j + 1];
  until j <= 0;

  for i := 1 to n do if not check[i] then begin
     inc(count) ;
       a[count] := i ;
       end ;

   ENd;

function ok( x : int64) : boolean ;
var i : integer;
begin
                while x > 0 do
                 begin
                      i := x mod 10 ;
                      if ( i<>4) and ( i<>7) then exit(false);
                      x := x div 10 ;
                 end ;
                 result := true ;
end ;

Procedure process;
var i , j : integer;

begin
     j := n ;
     if n > 14 then n := 14 ;
     if k > gt[n] then begin
          writeln(-1) ;
          halt ;
     end ;
     process1;
     for i := 1 to n do
      if ok(i) and ok(a[i]) then inc(res) ;

     n := j ;
     for i := 1 to nlk do if lk[i] > n then break ;
     inc(res,nlk-i) ;

     writeln(Res);
end ;
begin
     enter;
     process;
end.

{$mode objfpc}
var f:text;
    n,k:longint;
    a,b:array[0..13] of int64;
    pivot,m,l:int64;
    q:array[1..1100] of int64;
    first,last:longint;
    dem:longint;

procedure input;
begin
  assign(f,'');
  reset(f);
  readln(f,n,k);
  close(f);
end;

procedure push(x:int64);
begin
  inc(last);
  q[last]:=x;
end;

function pop:int64;
begin
  pop:=q[first];
  inc(first);
end;

procedure init;
var u,v:int64;
    i:longint;
begin
  dem:=0;
  pivot:=1;
  b[0]:=1;
  b[1]:=1;
  first:=1;
  last:=0;
  while k>b[pivot] do
    begin
      inc(pivot);
      b[pivot]:=b[pivot-1]*pivot;
    end;
  m:=pivot;
  l:=n-pivot+1;
  if l<=0 then
    begin
      dem:=-1;
      exit;
    end;
  if 4<l then
    begin
      push(4);
      inc(dem);
    end;
  if 7<l then
    begin
      push(7);
      inc(dem);
    end;
  while first<=last do
    begin
      u:=pop;
      v:=u*10+4;
      if v<l then push(v);
      v:=u*10+7;
      if v<l then push(v);
    end;
  for i:=l to n do
    begin
      a[i-l+1]:=i;
      //writeln(i);
    end;
end;

procedure qs(l,h:longint);
var i,j:longint;
    pivot:int64;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l];
  i:=l;
  j:=h;
  repeat
    while (i<j) and (a[j]>pivot) do dec(j);
    if i<j then
      begin
        a[i]:=a[j];
        inc(i);
      end
    else break;

    while (i<j) and (a[i]<pivot) do inc(i);
    if i<j then
      begin
        a[j]:=a[i];
        dec(j);
      end
    else break;
  until i=j;
  a[i]:=pivot;
  qs(l,i-1);
  qs(i+1,h);
end;

function kt(v:int64):boolean;
var u:longint;
begin
  while v<>0 do
    begin
      u:=v mod 10;
      if u<>4 then
        if v<>7 then exit(false);
      v:=v div 10;
    end;
  exit(true);
end;

procedure swap(var a,b:int64);
var temp:int64;
begin
  temp:=a;
  a:=b;
  b:=temp;
end;

procedure solve;
var i:longint;
begin
  while k<>0 do
    for i:=1 to pivot do
      if (k>(int64(i)-1)*b[pivot-1]) and (k<=(int64(i)*b[pivot-1])) then
        begin
          swap(a[m-pivot+i],a[m-pivot+1]);
          qs(m-pivot+2,m);
          k:=k-(int64(i)-1)*b[pivot-1];
          if k=1 then exit;
          dec(pivot);
        end;
end;

procedure output;
var i:longint;
begin
  if dem<>-1 then
    for i:=1 to m do
      if kt(a[i]) and kt(i+l-1) then inc(dem);
  writeln(dem);
end;

begin
  input;
  init;
  if dem<>-1 then solve;
  output;
end.

{$mode objfpc}
var f:text;
    n,k:longint;
    a,b:array[0..13] of int64;
    pivot,m,l:int64;
    q:array[1..1100] of int64;
    first,last:longint;
    dem:longint;

procedure input;
begin
  assign(f,'');
  reset(f);
  readln(f,n,k);
  close(f);
end;

procedure push(x:int64);
begin
  inc(last);
  q[last]:=x;
end;

function pop:int64;
begin
  pop:=q[first];
  inc(first);
end;

procedure init;
var u,v:int64;
    i:longint;
begin
  dem:=0;
  pivot:=1;
  b[0]:=1;
  b[1]:=1;
  first:=1;
  last:=0;
  while k>b[pivot] do
    begin
      inc(pivot);
      b[pivot]:=b[pivot-1]*pivot;
    end;
  m:=pivot;
  l:=n-pivot+1;
  if l<=0 then
    begin
      dem:=-1;
      exit;
    end;
  if 4<l then
    begin
      push(4);
      inc(dem);
    end;
  if 7<l then
    begin
      push(7);
      inc(dem);
    end;
  while first<=last do
    begin
      u:=pop;
      v:=u*10+4;
      if v<l then push(v);
      v:=u*10+7;
      if v<l then push(v);
    end;
  for i:=l to n do
    begin
      a[i-l+1]:=i;
      //writeln(i);
    end;
end;

procedure qs(l,h:longint);
var i,j:longint;
    pivot:int64;
begin
  if l>=h then exit;
  i:=random(h-l+1)+l;
  pivot:=a[i];
  a[i]:=a[l];
  i:=l;
  j:=h;
  repeat
    while (i<j) and (a[j]>pivot) do dec(j);
    if i<j then
      begin
        a[i]:=a[j];
        inc(i);
      end
    else break;

    while (i<j) and (a[i]<pivot) do inc(i);
    if i<j then
      begin
        a[j]:=a[i];
        dec(j);
      end
    else break;
  until i=j;
  a[i]:=pivot;
  qs(l,i-1);
  qs(i+1,h);
end;

function kt(v:int64):boolean;
var u:longint;
begin
  while v<>0 do
    begin
      u:=v mod 10;
      if u<>4 then
        if v<>7 then exit(false);
      v:=v div 10;
    end;
  exit(true);
end;

procedure swap(var a,b:int64);
var temp:int64;
begin
  temp:=a;
  a:=b;
  b:=temp;
end;

procedure solve;
var i:longint;
begin
  while k<>0 do
    for i:=1 to pivot do
      if (k>(int64(i)-1)*b[pivot-1]) and (k<=(int64(i)*b[pivot-1])) then
        begin
          swap(a[m-pivot+i],a[m-pivot+1]);
          qs(m-pivot+2,m);
          k:=k-(int64(i)-1)*b[pivot-1];
          if k=1 then exit;
          dec(pivot);
        end;
end;

procedure output;
var i:longint;
begin
  for i:=1 to m do
    if kt(a[i]) and kt(i+l-1) then inc(dem);
  writeln(dem);
end;

begin
  input;
  init;
  if dem<>-1 then solve;
  output;
end.

var
        z:int64;
        p:array[0..1025]of boolean;
        a,s:array[0..1025]of int64;
        ans,n,m,x,i,j,k,t:Longint;

function pd(x:longint):boolean;
begin
        while x>0 do begin
          if (x mod 10<>4) and (x mod 10<>7) then exit(false);
          x:=x div 10;
        end;
        exit(true);
end;

begin
        s[0]:=1; for i:=1 to 12 do s[i]:=s[i-1]*i;
        read(n,m); dec(m);
        if (n<=12) and (m+1>s[n]) then begin writeln(-1); exit end;
        t:=12; if t>n then t:=n; k:=n-t+1;
        a[1]:=4; a[2]:=7; j:=2; i:=0;
        repeat
          inc(i);
          z:=a[i]*10+4; if z<k then begin inc(j); a[j]:=z end;
          z:=z+3;       if z<k then begin inc(j); a[j]:=z end;
        until i=j;
        if k<=4 then ans:=0 else if k<=7 then ans:=1 else ans:=j; x:=t;
        for i:=k to n do begin
          dec(t);
          z:=m div s[t]; m:=m mod s[t];
          for j:=1 to x do begin
            if (z=0) and not p[j] then begin p[j]:=true; break; end;
            if not p[j] then dec(z);
          end;
          if pd(j+k-1) and pd(i) then inc(ans);
        end;
        writeln(ans);
end.

var
        z:int64;
        p:array[0..1025]of boolean;
        a,s:array[0..1025]of int64;
        ans,n,m,x,i,j,k,t:Longint;

function pd(x:longint):boolean;
begin
        while x>0 do begin
          if (x mod 10<>4) and (x mod 10<>7) then exit(false);
          x:=x div 10;
        end;
        exit(true);
end;

begin
        s[0]:=1; for i:=1 to 12 do s[i]:=s[i-1]*i;
        read(n,m); dec(m);
        t:=12; if t>n then t:=n; k:=n-t+1;
        a[1]:=4; a[2]:=7; j:=2; i:=0;
        repeat
          inc(i);
          z:=a[i]*10+4; if z<k then begin inc(j); a[j]:=z end;
          z:=z+3;       if z<k then begin inc(j); a[j]:=z end;
        until i=j;
        if k<=4 then ans:=0 else if k<=7 then ans:=1 else ans:=j; x:=t;
        for i:=k to n do begin
          dec(t);
          z:=m div s[t]; m:=m mod s[t];
          for j:=1 to x do begin
            if (z=0) and not p[j] then begin p[j]:=true; break; end;
            if not p[j] then dec(z);
          end;
          if pd(j+k-1) and pd(i) then inc(ans);
        end;
        writeln(ans);
end.

var
  n,k,temp,t:int64;
  i,j,ans,nn:longint;
  a:array[0..1 shl 12] of int64;
  fact:array[0..15] of int64;
  used:array[0..15] of boolean;
  z,s:array[0..15] of longint;
procedure lucky(x:int64);
  begin
    if x>10000000000 then exit;
	inc(nn); a[nn]:=x;
	lucky(10*x+4); lucky(10*x+7);
  end;

function islucky(a:int64):boolean;
  begin
    if a=0 then exit(true)
	else if not ((a mod 10) in [4,7]) then exit(false)
	else exit(islucky(a div 10));
  end;

begin
  lucky(4); lucky(7);
  for i:=1 to nn-1 do
    for j:=nn downto i+1 do
	  if a[j]<a[j-1] then
	    begin
		  temp:=a[j]; a[j]:=a[j-1]; a[j-1]:=temp;
		end;
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=fact[i-1]*i;
  if n<15 then
    if k>fact[n] then
	  begin
	    writeln(-1);halt;
	  end;
  dec(k);
  fillchar(used,sizeof(used),false);
  if n>15 then
    begin
	  temp:=n; n:=15;
	end;
  for i:=1 to n do z[i]:=i;
  for i:=1 to n do
    begin
	  t:=k div fact[n-i];
	  k:=k-t*fact[n-i];
	  s[i]:=z[t+1];
	  for j:=t+1 to n-1 do
	    z[j]:=z[j+1];
	end;
  if temp>15 then
    begin
	  for i:=1 to 15 do
	    if islucky(temp-15+int64(i)) and islucky(temp-15+int64(s[i])) then inc(ans);
	  for i:=1 to nn do
	    if a[i]>temp-15 then break
		  else inc(ans);
	end
  else for i:=1 to n do
    if islucky(int64(i)) and islucky(int64(s[i])) then inc(ans);
  writeln(ans);

end.

var
  n,k,temp,t:int64;
  i,j,ans:longint;
  fact:array[0..15] of int64;
  used:array[0..15] of boolean;
  z,s:array[0..15] of longint;

function islucky(a:int64):boolean;
  begin
    if a=0 then exit(true)
	else if not ((a mod 10) in [4,7]) then exit(false)
	else exit(islucky(a div 10));
  end;

begin
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=fact[i-1]*i;
  if n<15 then
    if k>fact[n] then
	  begin
	    writeln(-1);halt;
	  end;
  dec(k);
  fillchar(used,sizeof(used),false);
  if n>15 then
    begin
	  temp:=n; n:=15;
	end;
  for i:=1 to n do z[i]:=i;
  for i:=1 to n do
    begin
	  t:=k div fact[n-i];
	  k:=k-t*fact[n-i];
	  s[i]:=z[t+1];
	  for j:=t+1 to n-1 do
	    z[j]:=z[j+1];
	end;
  if temp>15 then
    begin
	  for i:=1 to 15 do
	    if islucky(temp-14+int64(i)) and islucky(temp-14+int64(s[i])) then inc(ans);
	end
  else for i:=1 to n do
    if islucky(int64(i)) and islucky(int64(s[i])) then inc(ans);
  writeln(ans);

end.

var
  n,k,temp,t:int64;
  i,j,ans:longint;
  fact:array[0..15] of int64;
  used:array[0..15] of boolean;
  z,s:array[0..15] of longint;

function islucky(a:int64):boolean;
  begin
    if a=0 then exit(true)
	else if not ((a mod 10) in [4,7]) then exit(false)
	else exit(islucky(a div 10));
  end;

begin
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=fact[i-1]*i;
  if n<15 then
    if k>fact[n] then
	  begin
	    writeln(-1);halt;
	  end;
  dec(k);
  fillchar(used,sizeof(used),false);
  if n>15 then
    begin
	  temp:=n; n:=15;
	end;
  for i:=1 to n do z[i]:=i;
  for i:=1 to n do
    begin
	  t:=k div fact[n-i];
	  k:=k-t*fact[n-i];
	  s[i]:=z[t+1];
	  for j:=t+1 to n-1 do
	    z[j]:=z[j+1];
	end;
  if temp>15 then
    begin
	  for i:=1 to 15 do
	    if islucky(temp-15+int64(i)) and islucky(temp-15+int64(s[i])) then inc(ans);
	end
  else for i:=1 to n do
    if islucky(int64(i)) and islucky(int64(s[i])) then inc(ans);
  writeln(ans);

end.

var
  n,k,temp,t:int64;
  i,j,ans:longint;
  fact:array[0..15] of int64;
  used:array[0..15] of boolean;
  z,s:array[0..15] of longint;

function islucky(a:int64):boolean;
  begin
    if a=0 then exit(true)
	else if not ((a mod 10) in [4,7]) then exit(false)
	else exit(islucky(a div 10));
  end;

begin
  readln(n,k);
  fact[0]:=1;
  for i:=1 to 15 do
    fact[i]:=fact[i-1]*i;
  if n<15 then
    if k>fact[n] then
	  begin
	    writeln(-1);halt;
	  end;
  dec(k);
  fillchar(used,sizeof(used),false);
  if n>15 then
    begin
	  temp:=n; n:=15;
	end;
  for i:=1 to n do z[i]:=i;
  for i:=1 to n do
    begin
	  t:=k div fact[n-i];
	  k:=k-t*fact[n-i];
	  s[i]:=z[t+1];
	  for j:=t+1 to n-1 do
	    z[j]:=z[j+1];
	end;
  {if temp>15 then
    begin
	  for i:=1 to 15 do
	    if islucky(temp-15+int64(i)) and islucky(temp-15+int64(s[i])) then inc(ans);
	end
  else }for i:=1 to n do
    if islucky(int64(i)) and islucky(int64(s[i])) then inc(ans);
  writeln(ans);

end.

const
  inf=1000000000;
var
  ss,m,i,j,n,k,kt,res:longint;
  t:array[0..500500]of longint;
  q,fact:array[0..500]of longint;
  was:array[0..500500]of boolean;
  procedure gen(x:longint);
    begin
      if (x<>0)then begin
        inc(kt);t[kt]:=x;
      end;
      if (int64(x)*10>inf)then exit;
      gen(x*10+4);
      gen(x*10+7);
    end;
begin
//  assign(input,'input.txt');reset(input);
//  assign(output,'output.txt');rewrite(output);
  read(n,k);
  kt:=0;
  gen(0);
  res:=0;
  for i:=1 to kt do
    if (t[i]<n-11)then inc(res);
  m:=n;
  ss:=1;
  fact[0]:=1;
  for i:=1 to m do fact[i]:=fact[i-1]*i;
  if (n>12)then begin
     m:=12;
     ss:=n-11;
  end else begin
    if (k>fact[n])then begin
      writeln(-1);
      exit;
    end;
  end;
  fillchar(was,sizeof(was),false);
  for i:=1 to m do begin
    j:=1;
    while (true)do begin
      while (was[j])do inc(j);
      if (k>fact[m-i])then begin
        dec(k,fact[m-i]);
        inc(j);
      end else break;
    end;
    was[j]:=true;
    q[i]:=ss+j-1;
  end;
  for i:=1 to kt do
    if (t[i]>=ss)and(t[i]<=n)then
      for j:=1 to kt do
        if (q[t[i]-ss+1]=t[j])then inc(res);
  writeln(res);
  close(output);close(input);
end.

{$r-,q-,s-,i-,o+}
const
  inf=1000000000;
var
  ss,m,i,j,n,k,kt,res:longint;
  t:array[0..500500]of longint;
  q,fact:array[0..500]of longint;
  was:array[0..500500]of boolean;
  procedure gen(x:longint);
    begin
      if (x<>0)then begin
        inc(kt);t[kt]:=x;
      end;
      if (int64(x)*10>inf)then exit;
      gen(x*10+4);
      gen(x*10+7);
    end;
begin
//  assign(input,'input.txt');reset(input);
//  assign(output,'output.txt');rewrite(output);
  read(n,k);
  kt:=0;
  gen(0);
  res:=0;
  for i:=1 to kt do
    if (t[i]<n-11)then inc(res);
  m:=n;
  ss:=1;
  fact[0]:=1;
  if (n>12)then begin
     m:=12;
     ss:=n-11;
     for i:=1 to m do fact[i]:=fact[i-1]*i;
  end else begin
    for i:=1 to n do fact[i]:=fact[i-1]*i;
    if (k>fact[n])then begin
      writeln(-1);
      exit;
    end;
  end;
  fillchar(was,sizeof(was),false);
  for i:=1 to m do begin
    j:=1;
    while (true)do begin
      while (was[j])do inc(j);
      if (k>fact[m-i])then begin
        dec(k,fact[m-i]);
        inc(j);
      end else break;
    end;
    was[j]:=true;
    q[i]:=ss+j-1;
  end;
  for i:=1 to kt do
    if (t[i]>=ss)and(t[i]<=n)then
      for j:=1 to kt do
        if (q[t[i]-ss+1]=t[j])then inc(res);
  writeln(res);
  close(output);close(input);
end.

const
{     fi='per.inp';
     fo='per.out';}
     fi='';
     fo='';
     maxn=3003;

var
     f:text;
     gt,c,d,a,b:array[0..maxn]of int64;
     ok:array[0..maxn]of boolean;
     spt,n,k:longint;

function maxx(x,y:longint):longint;
begin
     maxx:=x;
     if y>x then maxx:=y;
end;

function minn(x,y:longint):longint;
begin
     minn:=x;
     if y<x then minn:=y;
end;

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

procedure open;
var  i:longint;
begin
     assign(f,fi);reset(f);
     readln(f,n,k);
     close(f);
end;

procedure check(l:longint);
var  i:longint;
     s:int64;
begin
     s:=0;
     for i:=1 to l do s:=s*10+a[i];
     inc(spt);
     b[spt]:=s;
end;

procedure try(i,l:byte);
var  j:byte;
begin
     if i>l then check(l)
     else
     for j:=1 to 2 do
     begin
          if j=1 then a[i]:=4
          else a[i]:=7;
          try(i+1,l);
     end;
end;

function luck(x:int64):boolean;
begin
     while x<>0 do
     begin
          if (x mod 10<>4) and (x mod 10<>7) then exit(false);
          x:=x div 10;
     end;
     luck:=true;
end;

procedure main;
var  i,kq,j,t,m:longint;
begin
     spt:=0;
     for i:=1 to 10 do try(1,i);
     gt[0]:=1;
     for i:=1 to 13 do gt[i]:=gt[i-1]*i;
     for i:=1 to spt do d[i]:=b[i];

     if (n<=13) and (gt[n]<k) then kq:=-1
     else
     begin
          for m:=1 to 13 do
               if gt[m]>=k then break;
          fillchar(ok,sizeof(ok),true);
          for i:=1 to m do
          begin
               for j:=1 to m do
                    if ok[j] then
                         if k<=gt[m-i] then break
                         else k:=k-gt[m-i];
               c[i]:=j;
               ok[j]:=false;
          end;
          for i:=1 to m do
          begin
               j:=n-m+c[i];
               if luck(j) then
                    for t:=1 to spt do
                         if b[t]=j then
                         begin
                              d[t]:=n-m+i;
                              break;
                         end;
          end;
     end;

     kq:=0;
     for i:=1 to spt do
          if b[i]<=n then
               if luck(d[i]) then inc(kq);

     assign(f,fo);rewrite(f);
     writeln(f,kq);
     close(F);
end;

begin
     open;
     main;
end.

Program Lucky_Permutation;
Const
    MAXN                            =15+10;
    OO                              =987654321;
Var
    n,m,ans                         :longint;
    flag                            :array[0..MAXN] of boolean;
    c                               :array[0..MAXN] of int64;

Function Change(x:int64):int64;
Var
    i,j,k                           :longint;
    d                               :int64;
begin
    if x=0 then exit(4);
    d:=1;
    while d<=x do
    begin
        if x mod (d*10) div d=4 then
        begin
            x:=x+d*3;
            if d<>1 then
            begin
                d:=d div 10;
                while d>0 do
                begin
                    if x mod (d*10) div d=7 then
                        x:=x-3*d;
                    d:=d div 10;
                end;
            end;
            exit(x);
        end;
        d:=d*10;
    end;
    x:=0;
    while d>0 do
    begin
        x:=x+d*4;
        d:=d div 10;
    end;
    exit(x);
end;

Function Check(x:longint):boolean;
Var
    k                               :longint;
begin
    while x>0 do
    begin
        k:=x mod 10;
        if (k<>4) and (k<>7) then exit(false);
        x:=x div 10;
    end;
    exit(true);
end;

Procedure Main;
Var
    i,j,k,len,l                     :longint;
    now                             :int64;
begin
    readln(n,m);dec(m);
    c[0]:=1;
    for i:=1 to 15 do c[i]:=c[i-1]*i;
    if (n<=15) and (c[n]<m) then
    begin
        writeln('-1');
        halt;
    end;
    for i:=1 to 15 do
    if c[i]>m then break;
    len:=i;now:=4;
    while now<=n-len do
    begin
        inc(ans);
        now:=change(now);
    end;
    for i:=len-1 downto 0 do
    begin
        k:=m div c[i];
        j:=0;
        for l:=0 to k do
        begin
            inc(j);
            while flag[j] do inc(j);
        end;
        flag[j]:=true;
        if check(n-len+j) and check(n-i) then inc(ans);
        m:=m mod c[i];
    end;
    writeln(ans);
end;

Begin
    Main;
End.

Program Lucky_Permutation;
Const
    MAXN                            =15+10;
    OO                              =987654321;
Var
    n,m,ans                         :longint;
    flag                            :array[0..MAXN] of boolean;
    c                               :array[0..MAXN] of int64;

Function Change(x:int64):int64;
Var
    i,j,k                           :longint;
    d                               :int64;
begin
    if x=0 then exit(4);
    d:=1;
    while d<=x do
    begin
        if x mod (d*10) div d=4 then
        begin
            x:=x+d*3;
            if d<>1 then
            begin
                d:=d div 10;
                while d>0 do
                begin
                    if x mod (d*10) div d=7 then
                        x:=x-3*d;
                    d:=d div 10;
                end;
            end;
            exit(x);
        end;
        d:=d*10;
    end;
    x:=0;
    while d>0 do
    begin
        x:=x+d*4;
        d:=d div 10;
    end;
    exit(x);
end;

Function Check(x:longint):boolean;
Var
    k                               :longint;
begin
    while x>0 do
    begin
        k:=x mod 10;
        if (k<>4) and (k<>7) then exit(false);
        x:=x div 10;
    end;
    exit(true);
end;

Procedure Main;
Var
    i,j,k,len,l                     :longint;
    now                             :int64;
begin
    readln(n,m);
    c[0]:=1;
    for i:=1 to 15 do c[i]:=c[i-1]*i;
    if (n<=15) and (c[n]<=m) then
    begin
        writeln('-1');
        halt;
    end;dec(m);
    for i:=1 to 15 do
    if c[i]>m then break;
    len:=i;now:=4;
    while now<=n-len do
    begin
        inc(ans);
        now:=change(now);
    end;
    for i:=len-1 downto 0 do
    begin
        k:=m div c[i];
        j:=0;
        for l:=0 to k do
        begin
            inc(j);
            while flag[j] do inc(j);
        end;
        flag[j]:=true;
        if check(n-len+j) and check(n-i) then inc(ans);
        m:=m mod c[i];
    end;
    writeln(ans);
end;

Begin
    Main;
End.

Program Lucky_Permutation;
Const
    MAXN                            =15+10;
    OO                              =987654321;
Var
    n,m,ans                         :longint;
    flag                            :array[0..MAXN] of boolean;
    c                               :array[0..MAXN] of int64;

Function Change(x:int64):int64;
Var
    i,j,k                           :longint;
    d                               :int64;
begin
    if x=0 then exit(4);
    d:=1;
    while d<=x do
    begin
        if x mod (d*10) div d=4 then
        begin
            x:=x+d*3;
            if d<>1 then
            begin
                d:=d div 10;
                while d>0 do
                begin
                    if x mod (d*10) div d=7 then
                        x:=x-3*d;
                    d:=d div 10;
                end;
            end;
            exit(x);
        end;
        d:=d*10;
    end;
    x:=0;
    while d>0 do
    begin
        x:=x+d*4;
        d:=d div 10;
    end;
    exit(x);
end;

Function Check(x:longint):boolean;
Var
    k                               :longint;
begin
    while x>0 do
    begin
        k:=x mod 10;
        if (k<>4) and (k<>7) then exit(false);
        x:=x div 10;
    end;
    exit(true);
end;

Procedure Main;
Var
    i,j,k,len,l                     :longint;
    now                             :int64;
begin
    readln(n,m);dec(m);
    c[0]:=1;
    for i:=1 to 15 do c[i]:=c[i-1]*i;
    for i:=1 to 15 do
    if c[i]>m then break;
    len:=i;now:=4;
    while now<=n-len do
    begin
        inc(ans);
        now:=change(now);
    end;
    for i:=len-1 downto 0 do
    begin
        k:=m div c[i];
        j:=0;
        for l:=0 to k do
        begin
            inc(j);
            while flag[j] do inc(j);
        end;
        flag[j]:=true;
        if check(n-len+j) and check(n-i) then inc(ans);
        m:=m mod c[i];
    end;
    writeln(ans);
end;

Begin
    Main;
End.

Program Lucky_Permutation;
Const
    MAXN                            =15+10;
    OO                              =987654321;
Var
    n,m,ans                         :longint;
    flag                            :array[0..MAXN] of boolean;
    c                               :array[0..MAXN] of int64;

Function Change(x:int64):int64;
Var
    i,j,k                           :longint;
    d                               :int64;
begin
    if x=0 then exit(4);
    d:=1;
    while d<=x do
    begin
        if x mod (d*10) div d=4 then
        begin
            x:=x+d*3;
            if d<>1 then
            begin
                d:=d div 10;
                while d>0 do
                begin
                    if x mod (d*10) div d=7 then
                        x:=x-3*d;
                    d:=d div 10;
                end;
            end;
            exit(x);
        end;
        d:=d*10;
    end;
    x:=0;
    while d>0 do
    begin
        x:=x+d*4;
        d:=d div 10;
    end;
    exit(x);
end;

Function Check(x:longint):boolean;
Var
    k                               :longint;
begin
    while x>0 do
    begin
        k:=x mod 10;
        if (k<>4) and (k<>7) then exit(false);
        x:=x div 10;
    end;
    exit(true);
end;

Procedure Main;
Var
    i,j,k,len,l                     :longint;
    now                             :int64;
begin
    readln(n,m);dec(m);
    if (n<=15) and (c[n]<m) then
    begin
        writeln('-1');
        halt;
    end;
    c[0]:=1;
    for i:=1 to 15 do c[i]:=c[i-1]*i;
    for i:=1 to 15 do
    if c[i]>m then break;
    len:=i;now:=4;
    while now<=n-len do
    begin
        inc(ans);
        now:=change(now);
    end;
    for i:=len-1 downto 0 do
    begin
        k:=m div c[i];
        j:=0;
        for l:=0 to k do
        begin
            inc(j);
            while flag[j] do inc(j);
        end;
        flag[j]:=true;
        if check(n-len+j) and check(n-i) then inc(ans);
        m:=m mod c[i];
    end;
    writeln(ans);
end;

Begin
    Main;
End.

var a1:array[1..5000] of qword;
    a:array[1..20] of qword;
    ans:array[1..20] of longint;
    bo:array[1..20] of boolean;
    i,j,n,k,n1,tot,sum:longint;
    t,cator:qword;
    flag:boolean;
procedure dfs(m:longint; s:string);
  var t:qword;
  begin
    if m>10 then exit;
    if m>0 then
     begin
       val(s,t);
       inc(tot);
       a1[tot]:=t;
     end;
    dfs(m+1,s+'4');
    dfs(m+1,s+'7');
  end;
function cal(x:longint):qword;
  var i:longint;
      s:qword;
  begin
   s:=1;
   for i:=1 to x do s:=s*i;
   exit(s);
  end;
function check(x:longint):boolean;
  var i,t:longint;
      s:string;
  begin
    t:=x+n1;
    str(t,s);
    for i:=1 to length(s) do
     if (s[i]<>'4')and(s[i]<>'7') then exit(false);
    t:=ans[x]+n1;
    str(t,s);
    for i:=1 to length(s) do
     if (s[i]<>'4')and(s[i]<>'7') then exit(false);
    exit(true);
  end;
begin
  fillchar(bo,sizeof(bo),false);
  readln(n,k);
  flag:=false;
  cator:=1;
  for i:=2 to n do
   begin
     cator:=cator*i;
     if cator>=k then
      begin
        flag:=true;
        break;
      end;
   end;
  if not flag then
   begin
     writeln('-1');
     halt;
   end;
  if n>15 then
   begin
     n1:=n-15;
     n:=15;
     dfs(0,'');
     for i:=1 to tot-1 do
      for j:=i+1 to tot do
       if a1[i]>a1[j] then
        begin
          t:=a1[i];
          a1[i]:=a1[j];
          a1[j]:=t;
        end;
     for i:=1 to tot do
      if a1[i]<=n1 then inc(sum)
                   else break;
   end;
  cator:=k-1;
  for i:=n-1 downto 1 do
   begin
     flag:=false;
     a[n-i]:=cator div cal(i);
     cator:=cator mod cal(i);
     t:=0;
     j:=1;
     while (j<=n)and not flag do
      if not bo[j] then begin
                          inc(t);
                          if t=a[n-i]+1 then begin
                                               ans[n-i]:=j;
                                               flag:=true;
                                               bo[j]:=true;
                                             end
                                        else inc(j);
                        end
                   else inc(j);
   end;
  for i:=1 to n do
   if not bo[i] then
    begin
      ans[n]:=i;
      break;
    end;
  for i:=1 to n do
   if check(i) then inc(sum);
  writeln(sum);
end.

var
  a,b,rr,mar :array [1..10000] of int64;
  s:string;
  code: integer;
  n,nn,f,y,u,r,v,ans,k,w,e,x,h : int64;
  i,j,ii : longint;
  function fact(x : int64) : int64;
  var
  i: longint;
  e: int64;
   begin
    e:=1;
    for i:=1 to x do e:=e*i;
    fact:=e;
   end;
  function pos(x : int64) : boolean;
   begin
    pos:=false;
    for ii:=1 to v do
    if a[ii]=x then begin pos:=true; exit; end;
   end;
  function maxx(x: int64): int64;
  var
  i,e : longint;
  begin
  e:=x;
   for i:=n-f+1 downto 1 do
   if mar[i]=1 then
    begin
     e:=x+i;
     break;
    end;
    maxx:=e;
  end;
begin
  readln(n,k);
  i:=1;
  y:=1;
  while (y<k) and (i<=n) do
   begin
    y:=y*i;
    inc(I);
   end;
  r:=i-1;
  if y<k then begin writeln(-1);exit;end;
  nn:=1;
  while (nn<=10) do
   begin
    s:='';
    for i:=1 to nn do s:=s+'4';
    val(s,e,code);
    if e>n then break;
    inc(v);
    a[v]:=e;
    while true do
     begin
      j:=nn;
      while (j>=1) and (s[j]='7') do begin s[j]:='4'; dec(j); end;
      if j<1 then break;
      s[j]:='7';
      val(S,e,code);
      if e>n then break
      else
      begin
      inc(v);
      a[v]:=e;
      end;
     end;
     inc(nn);
   end;
  if e=0 then begin writeln(0);exit; end;
  f:=n-r+1;
  for i:=1 to v do
  if a[i]>=f then begin inc(u); b[u]:=a[i];end
  else
  inc(ans);
  for i:=f to n do
  for j:=1 to u do
   if i=b[j] then begin inc(h); rr[h]:=i-f+1;end;
  for i:=1 to n-f do
  begin
   e:=n-f+1-i;
   w:=fact(e);
   x:=k div w;
   if k mod w=0 then inc(X);
   x:=maxx(X);
   for j:=1to h do
    if (rr[j]=x) and (pos(i+f-1)) then inc(ans);
   mar[x]:=1;
    k:=k mod w;
    if k=0 then k:=w;
  end;
 for i:=1 to n-f+1 do
 if mar[i]=0 then
  begin
    for j:=1to h do
    if (rr[j]=i) and (pos(n-f+1)) then inc(ans);
  end;
 writeln(ans);
end.

var
  a,b,rr,mar :array [1..10000] of int64;
  s:string;
  code: integer;
  n,nn,f,y,u,r,v,ans,k,w,e,x,h : int64;
  i,j,ii : longint;
  function fact(x : int64) : int64;
  var
  i: longint;
  e: int64;
   begin
    e:=1;
    for i:=1 to x do e:=e*i;
    fact:=e;
   end;
  function pos(x : int64) : boolean;
   begin
    pos:=false;
    for ii:=1 to v do
    if a[ii]=x then begin pos:=true; exit; end;
   end;
  function maxx(x: int64): int64;
  var
  i,f,e : longint;
  begin
  e:=x;
  f:=0;
   for i:=1 to n-f+1 do
   if mar[i]=0 then
    begin
     inc(f);
     if f=x then begin e:=i;break;end;
    end;
    maxx:=e;
  end;
begin
  readln(n,k);
  i:=1;
  y:=1;
  while (y<k) and (i<=n) do
   begin
    y:=y*i;
    inc(I);
   end;
  r:=i-1;
  if y<k then begin writeln(-1);exit;end;
  nn:=1;
  while (nn<=10) do
   begin
    s:='';
    for i:=1 to nn do s:=s+'4';
    val(s,e,code);
    if e>n then break;
    inc(v);
    a[v]:=e;
    while true do
     begin
      j:=nn;
      while (j>=1) and (s[j]='7') do begin s[j]:='4'; dec(j); end;
      if j<1 then break;
      s[j]:='7';
      val(S,e,code);
      if e>n then break
      else
      begin
      inc(v);
      a[v]:=e;
      end;
     end;
     inc(nn);
   end;
  if e=0 then begin writeln(0);exit; end;
  f:=n-r+1;
  for i:=1 to v do
  if a[i]>=f then begin inc(u); b[u]:=a[i];end
  else
  inc(ans);
  for i:=f to n do
  for j:=1 to u do
   if i=b[j] then begin inc(h); rr[h]:=i-f+1;end;
  for i:=1 to n-f do
  begin
   e:=n-f+1-i;
   w:=fact(e);
   x:=k div w;
   if k mod w<>0 then inc(X);
   if mar[x]=1 then
   x:=maxx(x);
   for j:=1to h do
    if (rr[j]=x) and (pos(i+f-1)) then inc(ans);
   mar[x]:=1;
   k:=k mod w;
   if k=0 then k:=w;
  end;
 for i:=1 to n-f+1 do
 if mar[i]=0 then
  begin
    for j:=1to h do
    if (rr[j]=i) and (pos(n-f+1)) then inc(ans);
  end;
 writeln(ans);
end.

var
  a,b,rr,mar :array [1..10000] of int64;
  s:string;
  code: integer;
  n,nn,f,y,u,r,v,ans,k,w,e,x,h : int64;
  i,j,ii : longint;
  function fact(x : int64) : int64;
  var
  i: longint;
  e: int64;
   begin
    e:=1;
    for i:=1 to x do e:=e*i;
    fact:=e;
   end;
  function pos(x : int64) : boolean;
   begin
    pos:=false;
    for ii:=1 to v do
    if a[ii]=x then begin pos:=true; exit; end;
   end;
  function maxx(x: int64): int64;
  var
  i,f,e : longint;
  begin
  e:=x;
  f:=0;
   for i:=1 to n-f+1 do
   if mar[i]=0 then
    begin
     inc(f);
     if f=x then begin e:=i;break;end;
    end;
    maxx:=e;
  end;
begin
  readln(n,k);
  i:=1;
  y:=1;
  while (y<k) and (i<=n) do
   begin
    y:=y*i;
    inc(I);
   end;
  r:=i-1;
  if y<k then begin writeln(-1);exit;end;
  nn:=1;
  while (nn<=10) do
   begin
    s:='';
    for i:=1 to nn do s:=s+'4';
    val(s,e,code);
    if e>n then break;
    inc(v);
    a[v]:=e;
    while true do
     begin
      j:=nn;
      while (j>=1) and (s[j]='7') do begin s[j]:='4'; dec(j); end;
      if j<1 then break;
      s[j]:='7';
      val(S,e,code);
      if e>n then break
      else
      begin
      inc(v);
      a[v]:=e;
      end;
     end;
     inc(nn);
   end;
  if e=0 then begin writeln(0);exit; end;
  f:=n-r+1;
  for i:=1 to v do
  if a[i]>=f then begin inc(u); b[u]:=a[i];end
  else
  inc(ans);
  for i:=f to n do
  for j:=1 to u do
   if i=b[j] then begin inc(h); rr[h]:=i-f+1;end;
  for i:=1 to n-f do
  begin
   e:=n-f+1-i;
   w:=fact(e);
   x:=k div w;
   if k mod w<>0 then inc(X);
   x:=maxx(x);
   for j:=1to h do
    if (rr[j]=x) and (pos(i+f-1)) then inc(ans);
   mar[x]:=1;
   k:=k mod w;
   if k=0 then k:=w;
  end;
 for i:=1 to n-f+1 do
 if mar[i]=0 then
  begin
    for j:=1to h do
    if (rr[j]=i) and (pos(n-f+1)) then inc(ans);
  end;
 writeln(ans);
end.

var
  a,b,rr,mar :array [1..10000] of int64;
  s:string;
  code: integer;
  n,nn,f,y,u,r,v,ans,k,w,e,x,h : int64;
  i,j,ii : longint;
  function fact(x : int64) : int64;
  var
  i: longint;
  e: int64;
   begin
    e:=1;
    for i:=1 to x do e:=e*i;
    fact:=e;
   end;
  function pos(x : int64) : boolean;
   begin
    pos:=false;
    for ii:=1 to v do
    if a[ii]=x then begin pos:=true; exit; end;
   end;
  function maxx(x: int64): int64;
  var
  i,f,e : longint;
  begin
  e:=x;
  f:=0;
   for i:=1 to n-f+1 do
   if mar[i]=0 then
    begin
     inc(f);
     if f=x then begin e:=i;break;end;
    end;
    maxx:=e;
  end;
begin
  readln(n,k);
  i:=1;
  y:=1;
  while (y<k) and (i<=n) do
   begin
    y:=y*i;
    inc(I);
   end;
  r:=i-1;
  if y<k then begin writeln(-1);exit;end;
  nn:=1;
  while (nn<=10) do
   begin
    s:='';
    for i:=1 to nn do s:=s+'4';
    val(s,e,code);
    if e>n then break;
    inc(v);
    a[v]:=e;
    while true do
     begin
      j:=nn;
      while (j>=1) and (s[j]='7') do begin s[j]:='4'; dec(j); end;
      if j<1 then break;
      s[j]:='7';
      val(S,e,code);
      if e>n then break
      else
      begin
      inc(v);
      a[v]:=e;
      end;
     end;
     inc(nn);
   end;
  if e=0 then begin writeln(0);exit; end;
  f:=n-r+1;
  for i:=1 to v do
  if a[i]>=f then begin inc(u); b[u]:=a[i];end
  else
  inc(ans);
  for i:=f to n do
  for j:=1 to u do
   if i=b[j] then begin inc(h); rr[h]:=i-f+1;end;
  for i:=1 to n-f do
  begin
   e:=n-f+1-i;
   w:=fact(e);
   x:=k div w;
   if k mod w<>0 then inc(X);
   if mar[x]=1 then
   x:=maxx(n-f+1-i);
   for j:=1to h do
    if (rr[j]=x) and (pos(i+f-1)) then inc(ans);
   mar[x]:=1;
    k:=k mod w;
    if k=0 then k:=w;
  end;
 for i:=1 to n-f+1 do
 if mar[i]=0 then
  begin
    for j:=1to h do
    if (rr[j]=i) and (pos(n-f+1)) then inc(ans);
  end;
 writeln(ans);
end.

Var fac:array [0..15] of int64;
m:array [1..100] of byte;
a:array [1..15] of longint;
used:array [1..15]of boolean;
e,z,rez,kol,i,n,j,k:longint;
zz:int64;
function proverka(x:int64):boolean;
begin
  while x<>0 do
  begin
    if (x mod 10<>4)and(x mod 10<>7)
    then begin proverka:=false; exit; end;
    x:=x div 10;
  end;
  proverka:=true;
end;
begin
  //Assign(input,'input.txt'); reset(input);
  //Assign(output,'output.txt'); rewrite(output);
  read(n,k);
  fac[0]:=1;
  for i:=1 to 15 do
  fac[i]:=fac[i-1]*i;
  if n<=15
  then begin
        if fac[n]<k
        then begin
              writeln(-1);
              halt(0);
             end;
       end;
  kol:=0;
  if n>15
  then begin
         z:=1;
         while 1=1 do
         begin
           zz:=1;
           rez:=0;
           for i:=1 to z do
           begin
             if m[i]=0
             then rez:=rez+zz*4
             else rez:=rez+zz*7;
             zz:=zz*10;
           end;
           if rez<=n-15
           then inc(kol)
           else break;
           inc(m[1]);
           for i:=1 to z do
           if m[i]=2
           then begin
                 inc(m[i+1]);
                 m[i]:=0;
                end;
           if m[z+1]=1
           then begin
                 inc(z);
                 fillchar(m,sizeof(m),0);
                end;
         end;
         e:=15;
       end
  else e:=n;
  dec(k);
  for i:=1 to e do
  begin
    z:=1;
    while fac[e-i]<=k do
    begin
      k:=k-fac[e-i];
      inc(z);
    end;
    for j:=1 to e do
    if not used[j]
    then begin
          dec(z);
          if z=0
          then begin
                used[j]:=true;
                a[i]:=j;
                break;
               end;
         end;
  end;
  for i:=1 to e do
  if proverka(n-(e-i))and(proverka(n-e+a[i]))
  then inc(kol);
  writeln(kol);
end.

Var fac:array [0..15] of int64;
m:array [1..100] of byte;
a:array [1..15] of longint;
used:array [1..15]of boolean;
e,z,rez,kol,i,n,j,k:longint;
zz:int64;
function proverka(x:int64):boolean;
begin
  while x<>0 do
  begin
    if (x mod 10<>4)and(x mod 10<>7)
    then begin proverka:=false; exit; end;
    x:=x div 10;
  end;
  proverka:=true;
end;
begin
 // Assign(input,'input.txt'); reset(input);
 // Assign(output,'output.txt'); rewrite(output);
  read(n,k);
  fac[0]:=1;
  for i:=1 to 15 do
  fac[i]:=fac[i-1]*i;
  if n<=15
  then begin
        if fac[n]<k
        then begin
              writeln(-1);
              halt(0);
             end;
       end;
  kol:=0;
  if n>15
  then begin
         z:=1;
         while 1=1 do
         begin
           zz:=1;
           rez:=0;
           for i:=1 to z do
           begin
             if m[i]=0
             then rez:=rez+zz*4
             else rez:=rez+zz*7;
             zz:=zz*10;
           end;
           if rez<=n-k
           then inc(kol)
           else break;
           inc(m[1]);
           for i:=1 to z do
           if m[i]=2
           then begin
                 inc(m[i+1]);
                 m[i]:=0;
                end;
           if m[z+1]=1
           then inc(z);
         end;
         e:=15;
       end
  else e:=n;
  dec(k);
  for i:=1 to e do
  begin
    z:=1;
    while fac[e-i]<=k do
    begin
      k:=k-fac[e-i];
      inc(z);
    end;
    for j:=1 to e do
    if not used[j]
    then begin
          dec(z);
          if z=0
          then begin
                used[j]:=true;
                a[i]:=j;
                break;
               end;
         end;
  end;
  for i:=1 to e do
  if proverka(n-(e-i))and(proverka(n-e+a[i]))
  then inc(kol);
  writeln(kol);
end.

Var fac:array [0..15] of int64;
m:array [1..100] of byte;
a:array [1..15] of longint;
used:array [1..15]of boolean;
e,z,rez,kol,i,n,j,k:longint;
zz:int64;
function proverka(x:int64):boolean;
begin
  while x<>0 do
  begin
    if (x mod 10<>4)and(x mod 10<>7)
    then begin proverka:=false; exit; end;
    x:=x div 10;
  end;
  proverka:=true;
end;
begin
  //Assign(input,'input.txt'); reset(input);
  //Assign(output,'output.txt'); rewrite(output);
  read(n,k);
  fac[0]:=1;
  for i:=1 to 15 do
  fac[i]:=fac[i-1]*i;
  if n<=15
  then begin
        if fac[n]<k
        then begin
              writeln(-1);
              halt(0);
             end;
       end;
  kol:=0;
  if n>15
  then begin
         z:=1;
         while 1=1 do
         begin
           zz:=1;
           rez:=0;
           for i:=1 to z do
           begin
             if m[i]=0
             then rez:=rez+zz*4
             else rez:=rez+zz*7;
             zz:=zz*10;
           end;
           if rez<=n-15
           then inc(kol)
           else break;
           inc(m[1]);
           for i:=1 to z do
           if m[i]=2
           then begin
                 inc(m[i+1]);
                 m[i]:=0;
                end;
           if m[z+1]=1
           then inc(z);
         end;
         e:=15;
       end
  else e:=n;
  dec(k);
  for i:=1 to e do
  begin
    z:=1;
    while fac[e-i]<=k do
    begin
      k:=k-fac[e-i];
      inc(z);
    end;
    for j:=1 to e do
    if not used[j]
    then begin
          dec(z);
          if z=0
          then begin
                used[j]:=true;
                a[i]:=j;
                break;
               end;
         end;
  end;
  for i:=1 to e do
  if proverka(n-(e-i))and(proverka(n-e+a[i]))
  then inc(kol);
  writeln(kol);
end.