Live Computer Experiment

Stephen Wolfram

9.30am Saturday, April 24th 2004

In the Live Computer Experiment session at NKS 2004, participants were invited to see first hand what's involved in doing NKS research.

What follows is the notebook created by Stephen Wolfram as he carried out a live, unscripted NKS experiment.

Participants actively contributed comments and suggestions while the live demo was ongoing.

Note:

To keep the size of this file small, all graphics have been deleted. Evaluate the expressions below to regenerated the images.

CellularAutomaton[30, {{1}, 0}, 4]

CellularAutomaton[{30, 2, {{-1}, {0}, {1}}}, {{1}, 0}, 
      4]

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

Show[
        RasterGraphics[CellularAutomaton[30, {{1}, 0}, 50]]];

Show[
        GraphicsArray[
          Partition[
            Table[RasterGraphics[
                CellularAutomaton[{i, 2, {{-1}, {1}}}, {{1}, 0}, 
                  50, {All, All}], PlotLabel -> i], {i, 0, 15}], 
            4]]];

{x, x} -> x

Show[
        GraphicsArray[
          Partition[
            Table[RasterGraphics[
                CellularAutomaton[{i, 2, {{-1}, {2}}}, {{1}, 0}, 
                  50, {All, All}], PlotLabel -> i], {i, 0, 15}], 
            4]]];

Show[
        GraphicsArray[
          Partition[
            Table[RasterGraphics[
                CellularAutomaton[{i, 2, {{-1}, {0}, {2}}}, {{1}, 0}, 
                  50, {All, All}], PlotLabel -> i], {i, 0, 255}], 4], 
          GraphicsSpacing -> 0]];

Show[
        RasterGraphics[
          CellularAutomaton[{22, 2, {{-1}, {0}, {2}}}, {{1}, 0}, 
            200, {All, All}], PlotLabel -> i]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {2}}}, {{1}, 0}, 
            200, {All, All}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-2}, {0}, {2}}}, {{1}, 0}, 
            200, {All, All}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {3}}}, {{1}, 0}, 
            200, {All, All}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {4}}}, {{1}, 0}, 
            200, {All, All}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {4}}}, {{1}, 0}, 
            200, {All, {-200, 200}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {4}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {3}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {2}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {1}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {5}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {6}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {7}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {8}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {9}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {12}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{30, 2, {{-1}, {0}, {16}}}, {{1}, 0}, 
            500, {All, {-400, 400}}]]];

ListPlot[
        FoldList[Plus, 
          0, (-1)^
            Flatten[CellularAutomaton[{30, 2, {{-1}, {0}, {4}}}, {{1}, 
                  0}, 500, {All, {0}}]]], 
        PlotJoined -> True];

ListPlot[
        FoldList[Plus, 
            0, (-1)^
              Flatten[CellularAutomaton[{30, 2, {{-1}, {0}, {4}}}, {{1}, 
                    0}, 1000, {All, {0}}]]] + Range[1002]  .45, 
        PlotJoined -> True];

ListPlot[
        FoldList[Plus, 
          0, (-1)^
            Flatten[CellularAutomaton[{30, 2, {{-1}, {0}, {1}}}, {{1}, 
                  0}, 500, {All, {0}}]]], 
        PlotJoined -> True];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {2}}}, {{1}, 0}, 
            200, {All, {-200, 200}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {3}}}, {{1}, 0}, 
            200, {All, {-200, 200}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {4}}}, {{1}, 0}, 
            200, {All, {-200, 200}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {5}}}, {{1}, 0}, 
            200, {All, {-200, 200}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {2}}}, {{1, 1}, 0}, 
            200, {All, {-200, 200}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {2}}}, {{1, 1}, 0}, 
            400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {2}}}, {{1, 1}, 0}, 
            1000, {All, {-1000, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {3}}}, {{1, 1}, 0}, 
            400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {3}}}, {{1, 1, 1}, 0}, 
            400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {4}}}, {{1, 1}, 0}, 
            400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {4}}}, {{1, 1, 1}, 0}, 
            400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {4}}}, {{1, 1, 1, 1}, 
              0}, 400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {5}}}, {{1, 1, 1, 1}, 
              0}, 400, {All, {-400, 10}}]]];

Show[
        RasterGraphics[
          CellularAutomaton[{110, 2, {{-1}, {0}, {5}}}, {{1, 1, 1, 1, 1}, 
              0}, 400, {All, {-400, 10}}]]];