3
$\begingroup$

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!

$\endgroup$
  • 1
    $\begingroup$ Select[RecurrenceTable[{a[n + 1] == 7 a[n] + n, a[1] == 1}, a, {n, 7}], FreeQ[IntegerDigits@#, 7] &] $\endgroup$ – ciao May 15 '15 at 22:47
  • 2
    $\begingroup$ The last condition in Cases[] should probably be n_ /; FreeQ[IntegerDigits[n], 7] $\endgroup$ – J. M. is away May 15 '15 at 22:48
  • $\begingroup$ @ciao, this works great, however it affected the number of terms in the list .. it removed all numbers containing 7, but now i have less than 10 terms. Suggestion? $\endgroup$ – lara May 15 '15 at 23:02
  • $\begingroup$ Same goes for @J. M.'s answer! $\endgroup$ – lara May 15 '15 at 23:04
  • 1
    $\begingroup$ This is some homework exercise, say the prof. decides he wants 20 terms printed. He will have to calculate how many more to add to that {n, <something bigger>}. He won't bother with that, i believe. And that's why i'm looking for a more efficient solution. $\endgroup$ – lara May 15 '15 at 23:39
4
$\begingroup$

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.

$\endgroup$
3
$\begingroup$

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
$\endgroup$
  • $\begingroup$ Now that I think about it, DigitCount[] could also be used: no7Q = DigitCount[#, 10, 7] == 0 &. $\endgroup$ – J. M. is away May 16 '15 at 12:03
2
$\begingroup$

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]]
$\endgroup$
  • $\begingroup$ It is working :) $\endgroup$ – Sektor May 24 '15 at 13:22
  • $\begingroup$ Thanks. :) I forgot to test the blasted thing a few hours ago, when I had Mathematica access. Oh well… $\endgroup$ – J. M. is away May 24 '15 at 13:33
  • $\begingroup$ And I just saw it :D BTW you can access the Programming Cloud and still use (somewhat) Mathematica. $\endgroup$ – Sektor May 24 '15 at 13:53
  • $\begingroup$ I know a number of you guys are exhorting me to try the thing out, but somehow I feel I won't fully appreciate the thing on a smartphone… $\endgroup$ – J. M. is away May 24 '15 at 13:59
  • $\begingroup$ Have to set-up a Mathematica session over SSH for you then :D BTW If it is not private aren't you working with computers ? How come you are left without one ? $\endgroup$ – Sektor May 24 '15 at 14:41
2
$\begingroup$
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]"}]]

enter image description here

$\endgroup$
  • $\begingroup$ you might be interested that in my solution I already had tested up to n = 10^5 $\endgroup$ – Dr. Wolfgang Hintze May 24 '15 at 13:59
  • $\begingroup$ @Dr.WolfgangHintze...thank you, NestList...will get unwieldy, so like a constructive method $\endgroup$ – ubpdqn May 24 '15 at 23:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.