I'm going to call a prime that only consists of moslty 0's and few 1's a sparse prime. Here's some code to find even larger sparse primes. It runs surprisingly quickly.

(*Searches for a prime that matches the first digits of n and remaining digits 0 or 1.*)

sparsePrimeWithSeed[n_Integer] :=

Block[{k = 1, p, remainder},

p = NextPrime[10 n];

Monitor[

While[Quotient[p, 10^k] != n || !MatchQ[IntegerDigits[Mod[p, 10^(k + 1)]], {(0 | 1) ..}],

remainder = Mod[p, 10^(k + 1)];

p = NextPrime[10^(++k)*n]

],

remainder];

p

]

We can now look for primes whose first digits match Todd's prime and remaining digits are all 0 or 1.

In[2]:= sparsePrimeWithSeed[1 + 10^4 + 10^18 + 10^201]

Out[2]= 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000000010001000000000001

Or we can nest this function to get even larger sparse primes.

In[3]:= Nest[sparsePrimeWithSeed, 1 + 10^4 + 10^18 + 10^201, 5]

Out[3]= 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000000000000010001000000000001000000000011100000000000000110100000000000000010100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111

It turns out all primes seeded by Todd's prime aren't as sparse as the original. Here's a plot of the sparsity of succesive primes generated with the above code.

(* sparsity is number of 1's divided by integer length *)

ListLinePlot[

N[Total[IntegerDigits[#]]/IntegerLength[#]] & /@ NestList[sparsePrimeWithSeed, 1 + 10^4 + 10^18 + 10^201, 6],

PlotRange -> {0, .05}]