Reversible Transforms with Cellular Automata

Thomas Zheng

University of California, San Diego

NKS2004

Outline

Introduction

Examples of Reversible Transforms

Discrete Reversible Transforms with Cellular Automaton

Reversible CA's

Future Research

Why Study Reversible Transforms and Cellular Automaton?

Reversible Transforms are good engineering tools

Discrete Reversible Transforms using Cellular Automaton can be systematically studied

More useful and interesting transformations may be found

Examples of Reversible Transforms

Discrete Fourier Transforms

Walsh Transforms

Taking the codes from the NKS book, we can construct Walsh-Transform matrix in three different ways, i.e. there are three different ways to order the same set of basis vectors.

SequencyOrderWalshCode[s_] := 
      With[{f = Identity, g = Reverse}, 
        Nest[Apply[Join, 
              f[{Map[Flatten[Map[{#, #} &, #]] &, #], 
                  Map[Flatten[Map[{#, -#} &, #]] &, g[#]]}]] &, {{1}}, 
          s]]
NaturalOrderWalshCode[s_] := 
      With[{f = Transpose, g = Identity}, 
        Nest[Apply[Join, 
              f[{Map[Flatten[Map[{#, #} &, #]] &, #], 
                  Map[Flatten[Map[{#, -#} &, #]] &, g[#]]}]] &, {{1}}, 
          s]]
PaleyOrderWalshCode[s_] := 
        With[{f = Identity, g = Identity}, 
          Nest[Apply[Join, 
                f[{Map[Flatten[Map[{#, #} &, #]] &, #], 
                    Map[Flatten[Map[{#, -#} &, #]] &, g[#]]}]] &, {{1}}, 
            s]];
Show[
        GraphicsArray[{Graphics[
              Raster[Reverse[1 - SequencyOrderWalshCode[5]]]], 
            Graphics[Raster[Reverse[1 - NaturalOrderWalshCode[5]]]], 
            Graphics[
              Raster[Reverse[1 - PaleyOrderWalshCode[5]]]]}]];

Graphics Initialization & Preliminaries

The usual RasterGraphics function

RasterGraphics[state_?MatrixQ, colors_Integer:  3, opts___] := 
      Graphics[Raster[Reverse[1 - (state/(colors - 1))]], 
        AspectRatio -> (AspectRatio /. {opts} /. 
              AspectRatio -> Automatic), opts]

An even nicer function to display CAs

NiceRasterGraphics[state__?MatrixQ, colors_Integer:  2, 
        size_Integer:  1, opts___] := 
      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, opts]]

Some more graphics functions (from Ed's talk)

<< LinearAlgebra`MatrixManipulation`

<< LinearAlgebra`MatrixManipulation`

mycolors  = 
        Map[Apply[RGBColor, Reverse[N[#/255]]] &, {{255, 255, 255}, {0, 0, 
              0}, {160, 160, 160}, {160, 160, 160}}];

Off[General::spell];
Off[General::spell1];

ExpandRaster[datain_?MatrixQ, n_Integer] := 
      If[n == 1, datain, 
        Replace[datain, x_ :> Sequence @@ Table[x, {n}], 
          2]]

PadCenter[A_List, max_List]  :=  
      PadRight[PadLeft[A, Floor[(Dimensions[A] + max)/2]], 
        max]

Options[PPRaster] = {Frame -> False, MaxPixels -> 1, 
          MaxWidth -> 9999, MaxHeight -> 9999, 
          Margin -> 0};

PPRaster[raster_, dim_, opts___] := 
      Module[{margin, maxpixels, maxwidth, maxheight, ppc, m, 
          m2}, 
{frame, maxpixels, maxwidth, maxheight, 
            margin} = {Frame, MaxPixels, MaxWidth, MaxHeight, 
                Margin} /. {opts} /. 
            Options[PPRaster]; 
ppc = 
          Min[Floor[{maxwidth/dim[[1]], maxheight/dim[[2]], 
                maxpixels}]]; 
m = 
          margin*Max[dim]; 
m2 = 
          Ceiling[2 m]; 
Graphics[{raster, 
            If[frame, {AbsoluteThickness[0.25], 
                Line[{{-m, -m}, {-m, dim[[2]] + m}, 
                    dim + m, {dim[[1]] + 
                        m, -m}, {-m, -m}}]}, {}]}, 
          AspectRatio -> Automatic, 
          PlotRange -> {{-m2, dim[[1]] + m2}, {-m2, 
                dim[[2]] + m2}}, 
          If[ppc == 0, {}, 
            ImageSize -> {ppc*(dim[[1]] + 2 m2) + 1, 
                ppc*(dim[[2]] + 2 m2) + 1}]]]

Options[PPCellGraphics] = {Levels -> Automatic, 
          Blocking -> {1, 1}, BlockingLevels -> None, 
          Frame -> Absolute, FrameWidth -> 2, 
          FrameThickness ->  .25, Label -> None, 
          LabelDistance -> None, GraphicsOptions -> {}, 
          Colors -> None, 
          OverflowColor -> RGBColor[0, 0, 0]};

PPCellGraphics[(list_)?MatrixQ, opts___] := 
      Module[{levels, blocking, blev, label, goptions, colors, ofc, array, 
          raster}, {levels, blocking, blev, label, goptions, 
            colors} = {Levels, Blocking, BlockingLevels, Label, 
                GraphicsOptions, Colors} /. {opts} /. 
            Options[PPCellGraphics]; 
If[
          levels === Automatic, 
          levels = Max[Max[list] + 1, 2]]; 
array = 
          If[blocking =!= {1, 1}, 
            Flatten /@ Partition[list, {1, 1}, blocking], 
            list]; 
array = Reverse[array]; 
        If[colors === Automatic, 
          colors = $AutomaticColors]; 
If[colors === None, 
          array = If[levels == 2, 1 - array, 
              array /. Table[
                  i -> (levels - 1 - i)/(levels - 1), {i, 0, 
                    levels - 1}]]; 
raster = Raster[array], 
          ofc = OverflowColor /. {opts} /. 
              Options[PPCellGraphics]; 
raster = 
            RasterArray[colors[[#1]] & /@ (1 + 
                    array)]]; 
PPRaster[raster, 
          Reverse[Dimensions[array]], opts]]

PerfectGrid[PartitionedListOfMatrices_List]  :=  
      With[{jj = PartitionedListOfMatrices}, 
        Transpose[
          Insert[Transpose[
              Insert[
Apply[AppendColumns, 
                  Table[Apply[AppendRows, 
                      Table[jj[[x, y]]  + 1, {y, 
                          1, Dimensions[jj][[2]]}]], {x, 
                      1, Dimensions[jj][[1]]}]], 
                Table[0, {Dimensions[jj][[2]] Dimensions[
                          jj][[4]]}],  
                Table[{aa}, {aa, Dimensions[jj][[3]] + 
                      1, Dimensions[jj][[1]] Dimensions[
                            jj][[3]] - 
                      1,   Dimensions[jj][[3]]}]]], 
            Table[0, {(Dimensions[jj][[3]]  + 1) Dimensions[
                        jj][[1]]  - 
                  1}], 
Table[{bb}, {bb, Dimensions[
                      jj][[4]] + 
                  1, Dimensions[jj][[4]] Dimensions[
                        jj][[2]] - 
                  1,   Dimensions[
                    jj][[4]]}]
]]]

RasterGraphics[state_?MatrixQ, colors_Integer : 2, opts___] := 
      Graphics[Raster[Reverse[1 - (state/(colors - 1))]], 
        AspectRatio -> (AspectRatio /. {opts} /. 
              AspectRatio -> Automatic), opts]

Discrete Reversible Transforms with Cellular Automaton

Computer Experiment with Walsh Transforms

An N-point DFT can be brokend down into N/2 points DFT.  Taking this one step further, we can break down the entire DFT into a sum of 2 point DFT's.  The recursive procedure thens consists of (Subscript[log, 2])(N) steps.  The butterfly diagram below illustrates the recursive process of performing multiple DFT's of 2 samples at each step.

An additive Cellular Automaton rule is used to generate the FFT.

AdditiveStep[input_List] := 
      Flatten[Table[{input[[i]] + input[[i + 1]], 
            input[[i]] - input[[i + 1]]}, {i, 1, Length[input], 
            2}]]
AdditiveRule1[input_List] := 
      input[[2]] + input[[3]]
AdditiveRule2[input_List] := 
      input[[1]] - input[[2]]

Shuffling Rules

Shufflings are required in the FFT operation.  It can be thought of as a translation scheme as discussed by Matthew in the lecture.  These shuffling rules are not doing the actual computation, but serving the purpose of translating the input to a form operable by the Additive CA.

BitReverseShuffle[ls_] := 
      NestList[Flatten[Map[Transpose[Partition[#, 2]] &, #], 1] &, {ls}, 
        Log[2, Length[ls]] - 1]
Flatten[#] & /@ BitReverseShuffle[Range[16]] // 
        MatrixForm;
TranspositionShuffle[input_List] := 
      Flatten[Transpose[
          Partition[input, Length[input]/2]]]
TranspositionUnshuffle[input_List] := 
      Flatten[Transpose[Partition[input, 2]]]

The CA Rule that Shuffles

From computation experiment, I found that the following Reversible CA rule performs the shuffling required to compute Walsh Transforms

ReversibleCARules22 = {65535, 16711935, 16713975, 16724175, 16728255, 
          16740555, 50135295, 217252095, 252645135, 252645195, 252648975, 
          252652815, 252656655, 256577295, 256577355, 260509455, 264441615, 
          284098815, 753991935, 755961615, 755969295, 858993459, 858993555, 
          859005747, 859386675, 862139235, 862155363, 909325107, 959658291, 
          967915827, 1431655765, 2863311530, 3327051468, 3335309004, 
          3385642188, 3432811932, 3432828060, 3435580620, 3435961548, 
          3435973740, 3435973836, 3538998000, 3539005680, 3540975360, 
          4010868480, 4030525680, 4034457840, 4038389940, 4038390000, 
          4042310640, 4042314480, 4042318320, 4042322100, 4042322160, 
          4077715200, 4244832000, 4278226740, 4278239040, 4278243120, 
          4278253320, 4278255360, 4294901760};
CAShuffleRule2[n_Integer] := 
      Part[#, With[{steps = Log[2, Length[#]], 
              reversibleCA = 
                Last[CellularAutomaton[{n, 2, 
                        2}, #1, #2]] &}, 
Array[
              FromDigits[reversibleCA[IntegerDigits[#, 2, steps], 1], 2] + 
                  1 &, (2^steps), 0]]] &
TranspositionShuffleCA[input_List] := 
Part[
        input, 
Flatten[
CAShuffleRule2[
              ReversibleCARules22[[61]]]
[
            Range[1, Length[input]]]]]

ReversibleCARules22[[61]]

Final Form

The diagram below illustrates the algorithm used to compute the FFT using the additive CA

\(\(\(WalshXformCA1[input_] := 
      With[{n = 
            Length[input]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \(Flatten[
              Take[#, 1]] &\) /@ 
				\ \ \ \ \ \ \ NestList[{Flatten[
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \(AdditiveStep[TranspositionShuffle[#]] &\) /@ 
                    Partition[#[\([1]\)], 
                      2\^#[\([2]\)]]], \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #[\([2]\)] + 1} &, {input, 1}, 
            Log[2, n]]]\)\(
\)
    \)\)

\(\(\(WalshXformCA2[input_] := 
      With[{n = 
            Length[input]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \(Flatten[
              Take[#, 1]] &\) /@ 
				\ \ \ \ \ \ \ NestList[{Flatten[
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \(AdditiveStep[TranspositionShuffleCA[#]] &\) /@ 
                    Partition[#[\([1]\)], 
                      2\^#[\([2]\)]]], \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ #[\([2]\)] + 1} &, {input, 1}, 
            Log[2, n]]]\)\(
\)
    \)\)

Comparing with Paley Ordered Walsh Transform

input = Table[{2, 3, 1, 2}, {8}] // Flatten
results = WalshXformCA1[input]
result2 = 
      PaleyOrderWalshCode[Log[2, Length[input]]] . input

input = Table[{2, 3, 1, 2}, {16}] // Flatten
results = WalshXformCA2[input]
result2 = 
      PaleyOrderWalshCode[Log[2, Length[input]]] . input

ListDensityPlot[Reverse[results]];
ListPlot[Last[results], PlotJoined -> True];
ListPlot[result2, PlotJoined -> True];

Reversible CAs

When k=2, r=1, reversible CA's are not very interesting

len = 20;
ic = Random[Integer, {1, 2^len}];
Show[
GraphicsArray[
          Partition[(NiceRasterGraphics[
                    CellularAutomaton[{#, 2, 1},  IntegerDigits[ic, 2, len], 
                      50]]) & /@ {15, 51, 85, 170, 204, 240}, 
            3]]];

More Reversible CAs

When k=2, r=2, there are 62 reversible CA's.

ReversibleCARules22 = {65535, 16711935, 16713975, 16724175, 16728255, 
          16740555, 50135295, 217252095, 252645135, 252645195, 252648975, 
          252652815, 252656655, 256577295, 256577355, 260509455, 264441615, 
          284098815, 753991935, 755961615, 755969295, 858993459, 858993555, 
          859005747, 859386675, 862139235, 862155363, 909325107, 959658291, 
          967915827, 1431655765, 2863311530, 3327051468, 3335309004, 
          3385642188, 3432811932, 3432828060, 3435580620, 3435961548, 
          3435973740, 3435973836, 3538998000, 3539005680, 3540975360, 
          4010868480, 4030525680, 4034457840, 4038389940, 4038390000, 
          4042310640, 4042314480, 4042318320, 4042322100, 4042322160, 
          4077715200, 4244832000, 4278226740, 4278239040, 4278243120, 
          4278253320, 4278255360, 4294901760};

ReversibleQ[#, 2, 2, 15] & /@ ReversibleCARules22

Looking for Interesting Reversible CAs

Some interesting reversible CA's

RunReversibleCA[rule_Integer,  len_Integer,  steps_Integer, 
        ic_Integer] := 
      CellularAutomaton[{rule, 2, 2},  IntegerDigits[ic, 2, len], steps]; 
    testPattern[l_Integer, ic_Integer, 
        steps_Integer] := RunReversibleCA[#, l, steps, ic] & /@ 
        ReversibleCARules22;
resultPattern[
          input_List] := With[{st = #[[1]]}, 
              Flatten[Position[(Total[Mod[st + #, 2]]) & /@ #, 
                  0]]] & /@ input;
len = 6;
t1 = 
      Union[Flatten[Flatten[
                Position[resultPattern[testPattern[len, #,  23]], {1}]] & /@ 
            Range[1, 2^len]]]
ReversibleCARules22[[t1]]

Looking for Interesting Reversible CAs

len = 80;
ic = Random[Integer, {1, 2^len}];
Show[
GraphicsArray[
          Partition[NiceRasterGraphics[
                  CellularAutomaton[{#, 2, 2},  IntegerDigits[ic, 2, len], 
                    150]] & /@ 
              ReversibleCARules22[[{1, 9, 45, 52, 4, 8, 26, 29}]], 
            4]]];

Looking for Interesting Reversible CAs

Look a little further...

len = 8;
t1 = 
      Union[Flatten[Flatten[
                Position[resultPattern[testPattern[len, #,  50]], {1}]] & /@ 
            Range[1, 2^len]]]
ReversibleCARules22[[t1]]

len = 10;
t1 = ReversibleCARules22[[#]] & /@ (Flatten[
                  Position[
                    resultPattern[testPattern[len, #,  100]], {1}]] & /@ 
              Range[1, 2^len]);

    
Union[Flatten[t1]]

Looking for Interesting Reversible CAs

Look at All 62 Reversible CA's

len = 40;
ic = Random[Integer, {1, 2^len}];
Show[
GraphicsArray[
          Partition[NiceRasterGraphics[
                  CellularAutomaton[{#, 2, 2},  IntegerDigits[ic, 2, len], 
                    50]] & /@ ReversibleCARules22, 8]]];

Looking for Interesting Reversible CAs

len = 80;
ic = Random[Integer, {1, 2^len}];
Show[
GraphicsArray[
          Partition[NiceRasterGraphics[
                  CellularAutomaton[{#, 2, 2},  IntegerDigits[ic, 2, len], 
                    150]] & /@ 
              ReversibleCARules22[[{4, 8, 26, 29, 6, 19, 27, 29, 30}]], 
            4]]];

Future Research

Why do the eight reversible CA discussed have class 3 patterns?

If Combined with Additive CA, can the recusive operation yield other useful transforms?