Section 45
Want more of a challenge? View in iconic form (experimental)



       # GATE simulating unless gates
       # for embedded image-and-logic-based primer
       # practice with pure logic gate
       # X unless Y = (X if Y=0, otherwise 0)
[hear] (define unless /
         ? x / ? y /
         and (x) (not (y)));

       # if second input is true, output is blocked (false)
       # if second input is false, output copies first input
[hear] (= (false) (unless (false) (false)));

[hear] (= (true) (unless (true) (false)));

[hear] (= (false) (unless (false) (true)));

[hear] (= (false) (unless (true) (true)));

       # To do: add a simple simulator for non-grid-based
       # logic -- much simpler to understand than
       # grid-based
       # On to a grid-based logic simulation
       # first, need unbounded, mutable matrices
[hear] (define make-matrix /
         ? default /
         (make-cell (hash-default (default))));

[hear] (define matrix-set /
         ? m /
         ? x /
         ? addr /
         set! (m) / hash-add (get! (m)) (addr) (x));

[hear] (define matrix-get /
         ? m /
         ? addr /
         hash-ref (get! (m)) (addr));

[hear] (define test-matrix
         (make-matrix 0));

[hear] (= 0 / matrix-get (test-matrix) / vector 1 2 3);

[hear] (matrix-set (test-matrix) 10 / vector 1 2 3);

[hear] (= 10 / matrix-get (test-matrix) / vector 1 2 3);

       # go through a circuit of unless gates and analyze data flow
[hear] (define unless-phase-1 /
         ? circuit /
         assign state (make-matrix (false))
         (begin
           (map
            (? gate /
           assign x1 (list-ref (gate) 0) /
           assign y1 (list-ref (gate) 1) /
           assign x2 (list-ref (gate) 2) /
           assign y2 (list-ref (gate) 3) /
           assign v (list-ref (gate) 4) /
           (if (= (x1) (x2))
               (begin
                 (matrix-set (state) (v) / vector (x2) (y2) vert-value)
                 (matrix-set (state) (true) / vector (x2) (y2) vert-have)
                 (matrix-set (state) (true) / vector (x1) (y1) vert-want)
                 (gate))
               (begin
                 (matrix-set (state) (v) / vector (x2) (y2) horiz-value)
                 (matrix-set (state) (true) / vector (x2) (y2) horiz-have)
                 (matrix-set (state) (true) / vector (x1) (y1) horiz-want)
                 (gate))))
            (circuit))
           (state)));

       # move forward one simulation step
[hear] (define unless-phase-2 /
         ? circuit /
         ? state
         (map
          (? gate /
             assign x1 (list-ref (gate) 0) /
             assign y1 (list-ref (gate) 1) /
             assign x2 (list-ref (gate) 2) /
             assign y2 (list-ref (gate) 3) /
             assign v (list-ref (gate) 4) /
             assign nv (if (= (x1) (x2))
                   (if (matrix-get (state) / vector (x1) (y1) vert-have)
                   (and (matrix-get (state) /
                            vector (x1) (y1) vert-value)
                        (not (and (matrix-get (state) /
                                  vector (x1) (y1) horiz-value)
                              (not (matrix-get (state) /
                                   vector (x1) (y1) horiz-want)))))
                   (if (matrix-get (state) / vector (x1) (y1) horiz-have)
                       (matrix-get (state) / vector (x1) (y1) horiz-value)
                       (true)))
                   (if (matrix-get (state) / vector (x1) (y1) horiz-have)
                   (and (matrix-get (state) / vector (x1) (y1) horiz-value)
                        (not (and (matrix-get (state) /
                                  vector (x1) (y1) vert-value)
                              (not (matrix-get (state) /
                                   vector (x1) (y1) vert-want)))))
                   (if (matrix-get (state) / vector (x1) (y1) vert-have)
                       (matrix-get (state) / vector (x1) (y1) vert-value)
                       (true)))) /
                       vector (x1) (y1) (x2) (y2) (nv))
          (circuit)));

       # wrap up both phases of simulation
[hear] (define simulate-unless /
         ? circuit /
         assign state (unless-phase-1 (circuit)) /
         unless-phase-2 (circuit) (state));

       # A circuit is a list of gates
       # Each gate is a list (x1 y1 x2 y2 v)
       # where the coordinates (x1,y1) and (x2,y2) represent
       # start and end points of a wire on a plane, carrying a
       # logic value v.
       # Wires copy values from their start point.
       #   |
       #   | (A)
       #   V
       # -->-->
       # (B)(C)
       #
       # Wire C here copies from wire B.
       # If wire A is on, it blocks (sets to 0) C.
[hear] (assign circuit1
           (vector
            (vector 2 2 4 2 (true))
            (vector 4 2 6 2 (true))
            (vector 6 2 8 2 (true))
            (vector 6 4 6 2 (true))) /
            assign circuit2
            (vector
             (vector 2 2 4 2 (true))
             (vector 4 2 6 2 (true))
             (vector 6 2 8 2 (false))
             (vector 6 4 6 2 (true))) /
             equal (simulate-unless (circuit1)) (circuit2));

       # okay, now let us make a simple image class
       # we are going to encode each row as a single binary number,
       # rather than a vector, so that images will be pretty
       # obvious in the raw, uninterpreted message
[hear] (define bit-get /
         lambda (n offset) /
         assign div2 (div (n) 2)
         (if (= 0 / offset)
             (not / = (n) / * 2 / div2)
             (bit-get (div2) / - (offset) 1)));

[hear] (= 0 / bit-get (::.) 0);

[hear] (= 1 / bit-get (::.) 1);

[hear] (= 1 / bit-get (::.) 2);

[hear] (= 0 / bit-get (::.) 3);

[hear] (= 0 / bit-get (::.) 4);

[hear] (= 0 / bit-get 8 0);

[hear] (= 0 / bit-get 8 1);

[hear] (= 0 / bit-get 8 2);

[hear] (= 1 / bit-get 8 3);

[hear] (define make-image /
         lambda (h w lst) /
         vector (h) (w) (lst));

[hear] (define image-get /
         lambda (image row col) /
         assign h (list-ref (image) 0) /
         assign w (list-ref (image) 1) /
         assign lst (list-ref (image) 2) /
         assign bits (list-ref (lst) (row)) /
         bit-get (bits) (- (- (w) (col)) 1));

[hear] (define image-height /
         ? image /
         list-ref (image) 0);

[hear] (define image-width /
         ? image /
         list-ref (image) 1);

[hear] (define test-image /
         make-image 3 5 /
         vector (.....) (....:) (:....));

[hear] (= 3 (image-height / test-image));

[hear] (= 5 (image-width / test-image));

[hear] (= (false) (image-get (test-image) 0 0));

[hear] (= (false) (image-get (test-image) 0 4));

[hear] (= (false) (image-get (test-image) 1 0));

[hear] (= (true) (image-get (test-image) 1 4));

[hear] (= (true) (image-get (test-image) 2 0));

[hear] (= (false) (image-get (test-image) 2 4));

       # need a way to join two lists
[hear] (define merge-list /
         ? lst1 /
         ? lst2 /
         (if (> (list-length / lst1) 0)
             (prepend (head / lst1) (merge-list (tail / lst1) (lst2)))
             (lst2)));

[hear] (define merge-lists /
         ? lst /
         (if (> (list-length / lst) 2)
             (merge-list (head / lst) (merge-lists / tail / lst))
             (if (= (list-length / lst) 2)
             (merge-list (head / lst) / (head / tail / lst))
             (if (= (list-length / lst) 1)
                 (head / lst)
                 (vector)))));

             
             
[hear] (equal (vector 1 2 3 4) (merge-list (vector 1 2) (vector 3 4)));

[hear] (equal (vector 1 2 3 4) (merge-lists (vector (vector 1 2) (vector 3) (vector 4))));

       # helper for pairing
[hear] (define prefix /
         ? x /
         ? lst /
         map (? y (vector (x) (y))) (lst));

[hear] (equal (vector (vector 1 10) (vector 1 11))
              (prefix 1 (vector 10 11)));

       # need a way to take product of domains
[hear] (define pairing /
         ? lst1 /
         ? lst2
         (if (> (list-length / lst1) 0)
             (merge-list (prefix (head / lst1) (lst2))
                 (pairing (tail / lst1) (lst2)))
             (vector)));

[hear] (equal (vector (vector 1 10) (vector 1 11) (vector 2 10) (vector 2 11))
              (pairing (vector 1 2) (vector 10 11)));

       # need a way to make counting sets
[hear] (define count /
         ? lo / ? hi
         (if (<= (lo) (hi))
             (prepend (lo) (count (+ (lo) 1) (hi)))
             (vector)));

[hear] (equal (vector 0 1 2 3 4) (count 0 4));

       # given an image of a circuit, extract a model.
       # wire elements are centered on multiples of 8
       # individual element...
[hear] (define distill-element /
         ? image / ? xlogic / ? ylogic / ? xmid / ? ymid
         (if (image-get (image) (ymid) (xmid))
             (assign vert (image-get (image) (+ (ymid) 4) (xmid)) /
                 assign dx (if (vert) 0 1) /
                 assign dy (if (vert) 1 0) /
                 assign pos (image-get (image)
                           (+ (ymid) / + (* 4 / dy) (* 2 / dx))
                           (+ (xmid) / - (* 4 / dx) (* 2 / dy))) /
                 assign sgn (if (pos) 1 (- 0 1)) /
                 assign dx (* (sgn) (dx)) /
                 assign dy (* (sgn) (dy)) /
                 assign active (image-get (image) (+ (ymid) (dx)) (- (xmid) (dy))) /
                 (vector
                  (vector (- (xlogic) (dx))
                      (- (ylogic) (dy))
                      (+ (xlogic) (dx))
                      (+ (ylogic) (dy))
                      (active))))
             (vector)));

             
       # full circuit...
[hear] (define distill-circuit /
         ? image /
         assign h (div (image-height / image) 8) /
         assign w (div (image-width / image) 8)
         (merge-lists
          (map (? v /
              assign xlogic (list-ref (v) 0) /
              assign ylogic (list-ref (v) 1) /
              assign xmid (* 8 / xlogic) /
              assign ymid (* 8 / ylogic) /
              distill-element (image) (xlogic) (ylogic) (xmid) (ymid))
           (pairing (count 0 (- (w) 1))
                (count 0 (- (h) 1))))));