Pictorial Sequences

by Ed Pegg Jr.
See also Systems based on Numbers, at 
http://www.wolframscience.com/summerschool/2003/materials/

Initialization

<< DiscreteMath`Combinatorica`

<< DiscreteMath`RSolve`

<< NumberTheory`NumberTheoryFunctions`

Raster Graphics code by Oyvind Tafjord

RasterGraphics[state_, colors_:  2, size_:  1] := 
      With[{dim = Reverse[Dimensions[state]]}, 
        Graphics[Raster[Reverse[1 - state/(colors - 1)]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, dim[[1]]}, {0, dim[[2]]}}, 
          ImageSize -> size*dim + 1]]

AntiPosition[a_List]  :=  
        Total[Map[Join[Table[0, {12 - #}], {1}, Table[0, {# - 1}]] &, 
            a]];

Pictures

Mersenne primes

With[{seq  =  {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 
              607, 1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213, 
              19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091, 
              756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593, 
              13466917, 20996011}}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            3]]];

Mersenne primes http://www.research.att.com/cgi-bin/access.cgi/as/njas/sequences/eisA.cgi?Anum=A000043

Positive integers

Show[
        RasterGraphics[
          Transpose[
            Table[IntegerDigits[n, 2, 10], {n, 1, 700}]]]];

The positive integers       http://www.research.att.com/cgi-bin/access.cgi/as/njas/sequences/eisA.cgi?Anum=A000027

Ways of making change

With[{seq  = 
            Table[SeriesTerm[
                1/((1 - x) (1 - x^5) (1 - x^10) (1 - 
                          x^25)), {x, 0, n}], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

Ways of making change for n cents using coins of 1, 5, 10, 25 cents.   http://www.research.att.com/projects/OEIS?Anum=A001299

Triangular, Square, Cubic numbers

Show[
        RasterGraphics[
          Transpose[
            Table[IntegerDigits[n (n + 1)/2, 2, 20], {n, 1, 
                700}]]]];

Triangular numbers
http://www.research.att.com/projects/OEIS?Anum=A000217

With[{seq  =  Table[n^2, {n, 1, 700}]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

Square numbers
http://www.research.att.com/projects/OEIS?Anum=A000290

With[{seq  =  Table[n^3, {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

Cubic numbers
http://www.research.att.com/projects/OEIS?Anum=A000578

The Gray Code

With[{seq  = 
            Map[FromDigits[Reverse[#], 2] &, 
              Drop[Map[AntiPosition, Take[GrayCode[Range[10]], 700]], 1]]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

The Gray Code     http://www.research.att.com/projects/OEIS?Anum=A003188

Groups of order n

GroupsOfOrderN  =  {1, 1, 1, 2, 1, 2, 1, 5, 2, 2, 1, 5, 1, 2, 1, 
          14, 1, 5, 1, 5, 2, 2, 1, 15, 2, 2, 5, 4, 1, 4, 1, 51, 1, 2, 1, 14, 
          1, 2, 2, 14, 1, 6, 1, 4, 2, 2, 1, 52, 2, 5, 1, 5, 1, 15, 2, 13, 2, 
          2, 1, 13, 1, 2, 4, 267, 1, 4, 1, 5, 1, 4, 1, 50, 1, 2, 3, 4, 1, 6, 
          1, 52, 15, 2, 1, 15, 1, 2, 1, 12, 1, 10, 1, 4, 2, 2, 1, 231, 1, 5, 
          2, 16, 1, 4, 1, 14, 2, 2, 1, 45, 1, 6, 2, 43, 1, 6, 1, 5, 4, 2, 1, 
          47, 2, 2, 1, 4, 5, 16, 1, 2328, 2, 4, 1, 10, 1, 2, 5, 15, 1, 4, 1, 
          11, 1, 2, 1, 197, 1, 2, 6, 5, 1, 13, 1, 12, 2, 4, 2, 18, 1, 2, 1, 
          238, 1, 55, 1, 5, 2, 2, 1, 57, 2, 4, 5, 4, 1, 4, 2, 42, 1, 2, 1, 
          37, 1, 4, 2, 12, 1, 6, 1, 4, 13, 4, 1, 1543, 1, 2, 2, 12, 1, 10, 1, 
          52, 2, 2, 2, 12, 2, 2, 2, 51, 1, 12, 1, 5, 1, 2, 1, 177, 1, 2, 2, 
          15, 1, 6, 1, 197, 6, 2, 1, 15, 1, 4, 2, 14, 1, 16, 1, 4, 2, 4, 1, 
          208, 1, 5, 67, 5, 2, 4, 1, 12, 1, 15, 1, 46, 2, 2, 1, 56092, 1, 6, 
          1, 15, 2, 2, 1, 39, 1, 4, 1, 4, 1, 30, 1, 54, 5, 2, 4, 10, 1, 2, 4, 
          40, 1, 4, 1, 4, 2, 4, 1, 1045, 2, 4, 2, 5, 1, 23, 1, 14, 5, 2, 1, 
          49, 2, 2, 1, 42, 2, 10, 1, 9, 2, 6, 1, 61, 1, 2, 4, 4, 1, 4, 1, 
          1640, 1, 4, 1, 176, 2, 2, 2, 15, 1, 12, 1, 4, 5, 2, 1, 228, 1, 5, 
          1, 15, 1, 18, 5, 12, 1, 2, 1, 12, 1, 10, 14, 195, 1, 4, 2, 5, 2, 2, 
          1, 162, 2, 2, 3, 11, 1, 6, 1, 42, 2, 4, 1, 15, 1, 4, 7, 12, 1, 60, 
          1, 11, 2, 2, 1, 20169, 2, 2, 4, 5, 1, 12, 1, 44, 1, 2, 1, 30, 1, 2, 
          5, 221, 1, 6, 1, 5, 16, 6, 1, 46, 1, 6, 1, 4, 1, 10, 1, 235, 2, 4, 
          1, 41, 1, 2, 2, 14, 2, 4, 1, 4, 2, 4, 1, 775, 1, 4, 1, 5, 1, 6, 1, 
          51, 13, 4, 1, 18, 1, 2, 1, 1396, 1, 34, 1, 5, 2, 2, 1, 54, 1, 2, 5, 
          11, 1, 12, 1, 51, 4, 2, 1, 55, 1, 4, 2, 12, 1, 6, 2, 11, 2, 2, 1, 
          1213, 1, 2, 2, 12, 1, 261, 1, 14, 2, 10, 1, 12, 1, 4, 4, 42, 2, 4, 
          1, 56, 1, 2, 1, 202, 2, 6, 6, 4, 1, 8, 1, 10494213, 15, 2, 1, 15, 
          1, 4, 1, 49, 1, 10, 1, 4, 6, 2, 1, 170, 2, 4, 2, 9, 1, 4, 1, 12, 1, 
          2, 2, 119, 1, 2, 2, 246, 1, 24, 1, 5, 4, 16, 1, 39, 1, 2, 2, 4, 1, 
          16, 1, 180, 1, 2, 1, 10, 1, 2, 49, 12, 1, 12, 1, 11, 1, 4, 2, 8681, 
          1, 5, 2, 15, 1, 6, 1, 15, 4, 2, 1, 66, 1, 4, 1, 51, 1, 30, 1, 5, 2, 
          4, 1, 205, 1, 6, 4, 4, 7, 4, 1, 195, 3, 6, 1, 36, 1, 2, 2, 35, 1, 
          6, 1, 15, 5, 2, 1, 260, 15, 2, 2, 5, 1, 32, 1, 12, 2, 2, 1, 12, 2, 
          4, 2, 21541, 1, 4, 1, 9, 2, 4, 1, 757, 1, 10, 5, 4, 1, 6, 2, 53, 5, 
          4, 1, 40, 1, 2, 2, 12, 1, 18, 1, 4, 2, 4, 1, 1280, 1, 2, 17, 16, 1, 
          4, 1, 53, 1, 4, 1, 51, 1, 15, 2, 42, 2, 8, 1, 5, 4, 2, 1, 44, 1, 2, 
          1, 36, 1, 62, 1, 1387, 1, 2, 1, 10, 1, 6, 4, 15, 1, 12, 2, 4, 1, 2, 
          1, 840, 1, 5, 2, 5, 2, 13, 1, 40, 504, 4, 1, 18, 1, 2, 6, 195, 2, 
          10, 1, 15, 5, 4, 1, 54, 1, 2, 2, 11, 1, 39, 1, 42, 1, 4, 2, 189, 1, 
          2, 2, 39, 1, 6, 1, 4, 2, 2, 1, 1090235, 1, 12, 1, 5, 1, 16, 4, 15, 
          5, 2, 1, 53, 1, 4, 5, 172, 1, 4, 1, 5, 1, 4, 2, 137, 1, 2, 1, 4, 1, 
          24, 1};

Show[
        RasterGraphics[
          Join[2 Transpose[
                Map[IntegerDigits[#, 2, 
                      Ceiling[Log[2, Max[GroupsOfOrderN]]]] &, 
                  Take[GroupsOfOrderN, 700]]], 
            Transpose[Table[IntegerDigits[n, 2, 12], {n, 1, 700}]]], 
          3]];

The Small Groups Library   http://www-public.tu-bs.de:8080/~hubesche/small.html
Groups of order n.  http://www.research.att.com/projects/OEIS?Anum=A000001

Pascal's Triangle

With[{seq  = Flatten[Table[Binomial[a, b], {a, 0, 39}, {b, 0, a}]]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

Pascal's Triangle   http://www.research.att.com/projects/OEIS?Anum=A007318

Continued Fraction of Pi, order of SL(2,Z_n), the Primes

With[{cf  =  First[ContinuedFraction[Pi, {1000}]]}, 
        Show[RasterGraphics[
            Transpose[Table[IntegerDigits[cf[[n]], 2, 14], {n, 1, 700}]], 
            2, 1]]];

Continued Fraction of Pi   http://www.research.att.com/projects/OEIS?Anum=A001203

With[{seq  =  
            Table[n^3 
                 Times @@ (1 - 
                      1/Select[
                            Range[1, 
                              n], (Mod[n, #1] == 0 && 
                                  PrimeQ[#1]) &]^2), {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            1]]];

Order of SL(2,Z_n)    http://www.research.att.com/projects/OEIS?Anum=A000056

With[{seq  =  Table[Prime[n], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

The Primes   http://www.research.att.com/projects/OEIS?Anum=A000040

Divisors of n

With[{seq  =  Table[Length[Divisors[n]], {n, 1, 350}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            1]]];

Divisors of n.  Also, the number of Pythagorean triangles with radius of the inscribed circle equal to n.-Jaap Spies
http://www.research.att.com/projects/OEIS?Anum=A000005

Fibonacci Sequence

With[{seq  =  Table[Fibonacci[n], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            1]]];

Fibonacci Sequence   http://www.research.att.com/projects/OEIS?Anum=A000045

Other sequences

Show[
        RasterGraphics[
          Transpose[
            Table[IntegerDigits[Mod[Prime[n], n], 2, 20], {n, 1, 700}]], 2, 
          1]];

With[{cf  =  First[ContinuedFraction[E, {10000}]]}, 
        Show[RasterGraphics[
            Transpose[Table[IntegerDigits[cf[[n]], 2, 14], {n, 1, 700}]], 
            2, 1]]];

With[{seq  =  Table[EulerPhi[n], {n, 1, 350}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            3]]];

With[{seq  =  
            Table[Fold[#1 + EulerPhi[2  #2] 2^(n/#2)/(2  n) &, 0, 
                Divisors[n]], {n, 1, 350}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            2]]];

http://www.research.att.com/projects/OEIS?Anum=A000013    n-bead binary necklaces with beads of 2 colors where the colors may be swapped but turning over is not allowed.

With[{seq  =  Table[PartitionsP[n], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            1]]];

With[{seq  =  Table[PartitionsQ[n], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 7], {n, 1, Length[seq]}]]], 3, 
            1]]];

With[{seq  =  
            Table[Ceiling[Log[Binomial[2 n, n]/4]], {n, 1, 700}] }, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

With[{seq  = 
            Take[ Flatten[
                Table[If[PrimeQ[n^4 + n^3 + 1], n, {}], {n, 1, 70000}] ], 
              700]}, Show[
          RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

With[{seq  = 
            Take[Flatten[
                Table[If[OddQ[Total[IntegerDigits[n, 2]]], n, {}], {n, 1, 
                    7000}]], 350]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            2]]];

Odious numbers: odd number of 1's in binary expansion.   http://www.research.att.com/projects/OEIS?Anum=A000069

With[{seq  = (a[0] = 0; a[1] = 1; 
              a[n_] := If[EvenQ[n], a[n/2], 
                  a[(n - 1)/2] + a[(n + 1)/2]]; 
              Table[a[n], {n, 1, 700}])}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

number of ways of writing n-1 as a sum of powers of 2,each power being used at most twice (the number of hyperbinary representations of n)
http://www.research.att.com/projects/OEIS?Anum=A002487

With[{seq  = Table[DivisorSigma[1, n], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

sum of divisors of n  http://www.research.att.com/projects/OEIS?Anum=A000203

With[{seq  = Table[Total[Divisors[n]^2], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

sum of squares of divisors of n.http://www.research.att.com/projects/OEIS?Anum=A001157

With[{seq  = Table[Total[Divisors[n]], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

With[{seq  = 
            Table[Total[Drop[Divisors[n], -1]^2], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

sum of squares of proper divisors of n.  http://www.research.att.com/projects/OEIS?Anum=A001157

With[{seq  = 
            Table[Binomial[w + 2, 3] + Binomial[w + 1, 3], {w, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

Square Pyramid Numbers

With[{seq  = Table[n (3  n - 1)/2, {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

Pentagonal numbers: n(3n-1)/2.  http://www.research.att.com/projects/OEIS?Anum=A000326

With[{seq  = 
            Table[(n + 1) (n + 2) (n + 3)/6, {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

Tetrahedral (or pyramidal) numbers:C(n+3,3)=(n+1)(n+2)(n+3)/6   http://www.research.att.com/projects/OEIS?Anum=A000292

With[{seq  = 
            Table[Apply[Plus, MoebiusMu[n/Divisors[n]]*2^Divisors[n]]/n, {n, 
                1, 300}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

Degree n irreducible polynomials over GF(2)   http://www.research.att.com/projects/OEIS?Anum=A001037

With[{seq  = 
            Take[Flatten[
                Table[If[Total[Divisors[n]] > 2  n, n, {}], {n, 1, 3000}]], 
              700]}, Show[
          RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

http://www.research.att.com/projects/OEIS?Anum=A005101  Abundant numbers (sum of divisors of n exceeds 2n)

With[{seq  = 
            Table[(c = 0; k = 1; 
                While[k < n, 
                  If[Union[Transpose[
                              FactorInteger[
                                Binomial[n, 
                                  k]]][[2]]][[-1]] > 
                      1, c++]; k++]; c), {n, 1, 300}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            2]]];

Number of distinct non-square-free numbers among C(n,k)   http://www.research.att.com/projects/OEIS?Anum=A048277

With[{seq  = Table[Ceiling[Abs[1/Sin[n]]], {n, 1, 700}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            1]]];

With[{seq  = Table[Mod[7^n, n], {n, 1, 350}]}, 
        Show[RasterGraphics[
            Join[2 Transpose[
                  Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, 
                    seq]], Transpose[
                Table[IntegerDigits[n, 2, 11], {n, 1, Length[seq]}]]], 3, 
            2]]];

7^n mod n.  http://www.research.att.com/projects/OEIS?Anum=A066438

With[{seq  = 
            Table[FromDigits[
                Total[Map[
                    Join[Table[0, {NextPrime[700] - #}], {1}, 
                        Table[0, {# - 1}]] &, 
                    Map[PrimePi[First[#]] &, FactorInteger[n]]]], 2], {n, 2, 
                700}]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];

A binary representation of the primes that divide a number.  http://www.research.att.com/projects/OEIS?Anum=A087207

With[{seq  = 
            Abs[FoldList[Plus, 0, 
                Table[MoebiusMu[n] n  + 1, {n, 1, 700}]]]}, 
        Show[RasterGraphics[
            Transpose[
              Map[IntegerDigits[#, 2, Ceiling[Log[2, Max[seq]]]] &, seq]], 2, 
            1]]];