[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/BJeVH8A0    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Apr 22:
; rule 30 rng

(define (cycle xs) (set-cdr! (last-pair xs) xs) xs)

(define (last-pair xs)
  (if (null? (cdr xs)) xs
    (last-pair (cdr xs))))

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((n n) (d '()))
      (if (zero? n) d
          (loop (quotient n b)
                (cons (modulo n b) d))))))

(define (undigits ds . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((ds ds) (n 0))
      (if (null? ds) n
          (loop (cdr ds) (+ (* n b) (car ds)))))))

(define size (* 7 43))
(define result (quotient size 2))
(define state (make-vector size 0))

(define rule30 #(0 1 1 1 1 0 0 0))

(define (step)
  (let ((next (make-vector size 0)))
    (do ((i 0 (+ i 1))) ((= i size))
      (vector-set! next i 
        (vector-ref rule30
          (+ (* 4 (if (zero? i)
                      (vector-ref state (- size 1))
                      (vector-ref state (- i 1))))
             (* 2 (vector-ref state i))
             (if (= i (- size 1))
                 (vector-ref state 0)
                 (vector-ref state (+ i 1)))))))
    (set! state next)
    (vector-ref state result)))

(define (get n)
  (let loop ((n n) (xs '()))
    (if (zero? n)
        (undigits (reverse xs) 2)
        (loop (- n 1) (cons (step) xs)))))

(define block 43)

(define (init-state . xs)
  (set! state (make-vector size 0))
  (do ((i (- block 1) (+ i block))
       (xs (cycle xs) (cdr xs)))
      ((< size i))
    (do ((j i (- j 1))
         (ds (reverse (digits (car xs) 2)) (cdr ds)))
        ((null? ds))
      (vector-set! state j (car ds))))
  (do ((i 0 (+ i 1))) ((< (* size size (/ block)) i))
    (step)))

(define (pass n str)
  (let loop ((ss (string->list str)) (sum 0))
    (if (null? ss) sum
      (loop (cdr ss)
            (modulo (+ sum (* sum 256)
                       (char->integer (car ss)))
                    (expt 2 n))))))

(init-state (pass block "Programming Praxis"))

(time (do ((i 0 (+ i 1))) ((= i 50))
        (do ((j 0 (+ j 1))) ((= j 20))
          (display (get 8)) (display " "))
        (newline)))


Output:
90 187 70 13 31 230 168 44 155 213 210 34 213 86 113 82 10 66 61 234 
246 98 167 189 163 250 170 153 41 107 163 225 126 181 57 85 24 212 115 100 
199 123 17 49 221 87 69 196 158 230 93 179 1 80 121 108 201 38 185 205 
201 253 137 205 165 134 243 205 194 144 62 153 147 62 156 68 136 89 239 47 
135 72 196 101 93 41 0 152 52 120 45 83 10 138 131 80 30 61 152 10 
152 235 241 14 232 207 141 135 247 41 23 254 2 25 34 152 42 14 228 21 
88 251 227 30 180 147 117 78 3 48 115 235 127 125 230 12 85 64 121 117 
14 61 255 37 34 64 253 123 231 44 57 12 24 82 46 92 26 218 72 225 
206 120 2 0 205 79 121 247 208 73 13 45 204 198 35 226 21 216 100 45 
119 44 196 153 104 112 10 83 63 137 120 69 75 231 7 151 96 94 254 68 
53 76 10 93 82 72 106 45 104 146 248 76 80 52 55 132 154 110 245 114 
189 112 213 218 169 87 90 247 22 60 243 22 241 75 114 26 126 253 51 228 
19 79 14 244 253 164 116 179 170 214 224 27 150 204 100 153 75 22 94 196 
192 221 107 55 72 78 245 172 252 150 46 46 107 218 192 168 150 87 144 30 
132 156 193 21 100 199 251 38 167 83 32 132 189 22 231 68 52 242 220 230 
43 180 109 87 97 192 99 167 137 57 102 70 141 139 98 120 22 100 11 119 
243 10 101 41 164 159 88 133 70 171 28 156 226 115 4 14 254 141 179 165 
139 49 153 187 121 53 8 216 201 73 158 142 148 110 153 18 66 194 214 247 
208 192 44 13 47 165 219 7 175 23 137 120 159 89 122 169 15 99 248 123 
229 239 151 241 60 215 209 16 58 102 169 1 53 93 216 12 63 205 10 196 
96 221 162 11 179 247 119 173 2 81 129 251 43 73 122 216 171 20 25 246 
139 249 240 205 136 109 160 143 137 173 236 3 80 102 67 177 202 170 105 25 
89 8 180 253 11 188 62 89 254 169 33 115 119 77 9 240 205 104 158 16 
97 71 75 92 40 201 247 86 18 148 233 90 227 189 97 155 182 101 157 204 
64 235 139 87 177 187 70 97 98 45 77 130 43 101 18 27 111 161 225 245 
29 15 120 84 44 91 5 50 243 18 70 164 234 60 20 49 2 43 36 206 
42 194 61 254 12 118 133 95 30 111 215 46 195 234 199 186 98 146 238 72 
129 202 87 109 110 111 234 254 93 100 214 77 85 133 222 87 102 57 155 207 
87 178 95 234 216 54 42 127 8 169 203 105 170 254 212 187 82 193 255 215 
231 120 195 153 194 166 113 187 232 224 87 150 44 91 191 142 15 158 218 5 
216 19 131 60 136 178 77 47 24 41 234 246 158 138 234 210 177 195 205 189 
213 133 213 192 20 180 213 73 1 10 220 213 222 204 86 212 136 184 226 138 
19 120 15 108 59 3 45 18 2 32 24 32 122 31 61 243 150 185 41 200 
204 145 143 229 13 153 82 67 11 58 49 196 59 130 236 55 99 45 58 112 
135 241 225 187 53 75 68 73 97 193 47 176 242 65 12 220 126 243 106 132 
180 184 186 193 77 70 43 39 205 93 253 117 216 96 112 32 194 243 34 215 
130 250 126 7 32 159 80 151 138 37 36 151 232 20 7 10 38 111 49 50 
39 33 218 1 195 19 245 167 175 82 11 49 24 171 178 133 232 207 243 253 
106 236 66 197 72 18 152 114 13 208 93 54 232 179 29 13 219 229 55 152 
153 236 60 120 26 55 3 116 124 102 194 196 246 97 24 84 229 169 59 102 
214 129 139 124 220 245 56 206 94 146 69 105 248 39 106 200 84 171 202 131 
131 150 60 250 19 190 69 176 109 43 42 86 13 154 105 195 76 141 233 124 
16 96 224 58 33 142 89 92 154 195 92 31 106 160 100 26 165 39 30 59 
14 45 16 171 183 199 144 149 25 86 164 111 211 181 84 144 103 7 168 135 
7 187 30 19 2 224 194 98 64 49 38 96 7 199 73 129 183 82 76 143 
182 97 48 16 188 221 18 251 118 85 88 183 11 109 201 132 66 230 30 154 
237 6 61 202 9 183 165 202 97 125 76 186 141 240 112 83 81 38 217 171 
26 75 21 144 23 192 240 55 133 71 166 42 182 110 91 43 233 39 52 39 
145 136 42 167 235 76 138 241 190 110 17 58 233 74 96 254 205 143 250 82 
50 250 244 55 182 109 16 36 46 69 188 238 71 218 200 118 224 148 41 101 
cpu time: 480 real time: 3714 gc time: 20


Create a new paste based on this one


Comments: