Print all numbers from a sequence which don't contain the digit 7

Question

so i have this:
Cases[RecurrenceTable[{a[n + 1] == 7 a[n] + n, a[1] == 1}, a, {n, 7}], Except[7]]

But i noticed that it will only exclude numbers that are 7, and not numbers which contain 7.

If anyone can tell me the answer, i will be very grateful. Any help is appreciated. Thanks!

Answer 1

An interesting problem which at first sight looks innocent. But then ...

My (bold) conjecture is that the maximum number lg of terms you can get of this recurrence if a[1] == 1 is lg = 11.

First we solve the recurrence explicitly

sol = RSolve[a[n + 1] == 7 a[n] + n && a[1] == 1, a[n], n];

a[n] /. First[sol]

(*
Out[317]= 1/252 (-7 + 43 7^n - 42 n)
*)

This can be simplified to

c[n_] = 7^(-1 + n) + 1/36 (-1 + 7^n - 6 n)

Remark: I did it by hand because Mathematica was reluctant to do so as almost always in simple cases like this.

Next we calculate nn terms of the series. Let's start with nn = 50

nn = 50;
t = Table[c[n], {n, 1, nn}];

and select the terms which do not contain any digit 7.

s = Select[t, FreeQ[IntegerDigits[#], d] &]

(*
Out[348]= {1, 8, 58, 409, 140524, 48200140, 2361806941, 16532648599, 39694889291465, \
549428363095106064500063, 306880939816820326605841486684503658800800}
*)

The length of this list is

lg = Length[s]

(*
Out[350]= 11
*)

nn = 50 is "critical" in the sense that nn = 49 only leads to lg = 10.

The last term

c[50]

(*
Out[351]= 306880939816820326605841486684503658800800
*)

has

Length[IntegerDigits[%]]

(*
Out[353]= 42
*)

digits.

Now we increase nn in order to find longer lists. I tested up to nn = 10^5 without finding new terms.

The maximum term tested had

Length[IntegerDigits[c[10^5]]]

(*
Out[356]= 84510
*)

digits.

Extension 1:

Considering different values for a[1] we observe that the lengths of the series remain rather small.

With nn = 10^4 and a[1] between 0 and 200 the lengths and their multiplicities, respectively, are

tallylga = 
{{4, 2}, {5, 2}, {6, 7}, {7, 21}, {8, 28}, {9, 31}, {10, 44}, 
{11, 26}, {12, 20}, {13, 13}, {14, 5}, {15, 1}, {16, 1}}

The maximum of 16 is reached for a[1] = 86.

Extension 2:

Replacing 7 by any other (decimal) digit.

But wait, there's still a hole to be fixed: the proof that no more terms exist or the falseness of my conjecture. But this requires sufficient theoretical knowledge in number theory - which I don't have at the moment.

EDIT #1 21.05.15

This is not a proof of the conjecture but a plausibility argument that for a large integer the probability of lacking a specific decimal digit goes to zero.

In fact, let d be the number of decimal digits of n. The number of nubers with d digits in which one specific digit is missing is less than 9^d. Hence the density of theses numbers within all numbers of d digits is (9/10)^d which goes to zero with increasing d i.e. increasing n.

However, this does not help in our specific problem with expressions of the form b^n for which we conjecture the much stronger statement that above a certain n = n_crit there is no (!) decimal digit missing.

Answer 2

This is mostly a copy and paste of the brilliant answer by @WReach regarding implementation of lazy lists in Mathematica.

I'll refer you to that answer for a detailed explanation of his concept of a stream and only detail the modifications I made for this particular problem.

ClearAll[stream]
SetAttributes[stream, {HoldAll, Protected}]

sEmptyError[] := (Message[stream::empty]; Abort[])
stream::empty = "Attempt to access beyond the end of a stream.";

ClearAll[sEmptyQ, sHead, sTail, sTake, sList, sMap, sFilter, sIntegers]

sEmptyQ[stream[]] := True
sEmptyQ[stream[_, _]] = False;

sHead[stream[]] := sEmptyError[]
sHead[stream[h_, _]] := h

sTail[stream[]] := sEmptyError[]
sTail[stream[_, t_]] := t

sTake[s_stream, 0] := stream[]
sTake[s_stream, n_] /; n > 0 := 
 With[{nn = n - 1}, stream[sHead[s], sTake[sTail[s], nn]]]

sList[s_stream] := 
 Module[{tag}, 
  Reap[NestWhile[(Sow[sHead[#], tag]; sTail[#]) &, s, ! sEmptyQ[#] &],
      tag][[2]] /. {l_} :> l]

sMap[stream[], _] := stream[]
sMap[s_stream, fn_] := stream[fn[sHead[s]], sMap[sTail[s], fn]]

sFilter[s_, pred_] := 
 NestWhile[sTail, s, (! sEmptyQ[#] && ! pred[sHead[#]]) &] /. 
  stream[h_, t_] :> stream[h, sFilter[t, pred]]

The above code block defines operations on expressions with head stream. Explanations are given in the linked answer.

sSequence[v_: 1, n_: 1] := With[{nn = n + 1, vv = 7 v + n}, stream[v, sSequence[vv, nn]]]

I create a function called sSequence which generates a lazy list conforming to the rule given by OP: next element is seven times previous element plus number of element. As you can see, it takes two arguments - value of element, plus number of element and creates a lazy list generating all subsequent elements in accordance with the rule.

Then define a filter to get rid of numbers with the digit 7:

noSevenQ = FreeQ[IntegerDigits[#], 7] &

and take the first nine elements. Ten is also fine. Mathematica fails to find an 11th element without 7 quickly enough.

sSequence[]~sFilter~noSevenQ~sTake~9 // sList

Answer 3

I don't have Mathematica to test this, but I think something like this ought to work:

Block[{n = 10, k= 0},
          NestList[NestWhile[(k++; 7 # + k) &, #, DigitCount[#, 10, 7] != 0 &,
                                          {2, 1}] &, 1, n]]

Answer 4

s[n_] := Reap[
    NestList[
     Sow[{#[[1]] + 1, 7 #[[2]] + #[[1]]}, 
       FreeQ[IntegerDigits[7 #[[2]] + #[[1]]], 7]] &, 
     Sow[{1, 1}, True], n], True][[2, 1]];

So for the first 100 members of sequence 11 comply:

Grid[Prepend[s[100], {"n", "a[n]"}]]