Elementary cellular automaton: Difference between revisions
Content added Content deleted
(Updated D entry) |
m (→{{header|Racket}}: Better code formatting) |
||
Line 890: | Line 890: | ||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
This is the base code for the three elementary CA tasks. The "wrap" code |
This is the base code for the three elementary CA tasks. The "wrap" code |
||
is a little over-complicated for the simple cases of wrapping on word |
|||
boundaries and for CA's with a narrower word. However, it will be used |
|||
unmodified for [[Elementary cellular automaton/Infinite length]]. |
|||
<lang racket>#lang racket |
<lang racket>#lang racket |
||
Line 905: | Line 908: | ||
(define (shift-left-1-bit-with-msb-R n R) |
(define (shift-left-1-bit-with-msb-R n R) |
||
(fxior (fxand usable-bits/mask (fxlshift n 1 |
(fxior (fxand usable-bits/mask (fxlshift n 1)) |
||
(if (bitwise-bit-set? R usable-bits/fixnum-1) 1 0))) |
|||
(define ((CA-next-bit-state rule) L n R) |
(define ((CA-next-bit-state rule) L n R) |
||
(for/fold ( |
(for/fold ([n+ 0]) |
||
( |
([b (in-range usable-bits/fixnum-1 -1 -1)]) |
||
(define bit.2 (if (bitwise-bit-set? (shift-right-1-bit-with-lsb-L L n) b) 4 0)) |
(define bit.2 (if (bitwise-bit-set? (shift-right-1-bit-with-lsb-L L n) b) 4 0)) |
||
(define bit.1 (if (bitwise-bit-set? n b) 2 0)) |
(define bit.1 (if (bitwise-bit-set? n b) 2 0)) |
||
(define bit.0 (if (bitwise-bit-set? (shift-left-1-bit-with-msb-R n R) b) 1 0)) |
(define bit.0 (if (bitwise-bit-set? (shift-left-1-bit-with-msb-R n R) b) 1 0)) |
||
(define rule-bit (fxior bit.2 (fxior bit.1 bit.0))) |
(define rule-bit (fxior bit.2 (fxior bit.1 bit.0))) |
||
(fxior (fxlshift n+ 1) (if (bitwise-bit-set? rule rule-bit) 1 0)))) |
|||
;; CA-next-generation generates a function which takes: |
;; CA-next-generation generates a function which takes: |
||
Line 930: | Line 934: | ||
;; offset- : a new value for offset (it will have decreased since the CA grows to the left |
;; offset- : a new value for offset (it will have decreased since the CA grows to the left |
||
;; with offset, and to the right with (length v-out) |
;; with offset, and to the right with (length v-out) |
||
(define (CA-next-generation rule #:wrap-rule (wrap-rule |
(define (CA-next-generation rule #:wrap-rule (wrap-rule values)) |
||
(define next-state (CA-next-bit-state rule)) |
(define next-state (CA-next-bit-state rule)) |
||
(lambda (v-in offset) |
(lambda (v-in offset) |
||
(define vl-1 (fx- (fxvector-length v-in) 1)) |
(define vl-1 (fx- (fxvector-length v-in) 1)) |
||
(define-values |
(define-values [v+ v+l-1 offset-] (wrap-rule v-in vl-1 offset)) |
||
(define rv |
(define rv |
||
(for/fxvector |
(for/fxvector ([l (in-sequences (in-value (fxvector-ref v+ v+l-1)) (in-fxvector v+))] |
||
[n (in-fxvector v+)] |
|||
( |
[r (in-sequences (in-fxvector v+ 1) (in-value (fxvector-ref v+ 0)))]) |
||
( |
(next-state l n r))) |
||
(next-state l n r))) |
|||
(values rv offset-))) |
(values rv offset-))) |
||
Line 967: | Line 970: | ||
(display (~a #:width sig-bits #:align 'right #:pad-string "0" |
(display (~a #:width sig-bits #:align 'right #:pad-string "0" |
||
(number->string (fxvector-ref v 0) 2)))) |
(number->string (fxvector-ref v 0) 2)))) |
||
(for ( |
(for ([n (in-fxvector v (if sig-bits 1 0))]) |
||
(display (~a #:width usable-bits/fixnum #:align 'right #:pad-string "0" (number->string n 2))))) |
(display (~a #:width usable-bits/fixnum #:align 'right #:pad-string "0" (number->string n 2))))) |
||
(module+ main |
(module+ main |
||
(define ng/122/19-bits (CA-next-generation 122 #:wrap-rule (wrap-rule-truncate-left-word 19))) |
(define ng/122/19-bits (CA-next-generation 122 #:wrap-rule (wrap-rule-truncate-left-word 19))) |
||
(for/fold ( |
(for/fold ([v (fxvector #b1000000000)] [o 0]) ([step (in-range 40)]) |
||
(show-automaton v #:step step #:sig-bits 19) |
(show-automaton v #:step step #:sig-bits 19) |
||
(newline) |
(newline) |