master
Matthew Butterick 7 years ago
parent 291d451292
commit 7086673c77

@ -2,7 +2,7 @@
(provide (rename-out [#%mb #%module-begin]))
(define-macro (#%mb (STARS) (NUMBER) ...)
#'(#%module-begin (captcha-sum 'STARS NUMBER) ...))
#'(#%module-begin (time (captcha-sum 'STARS NUMBER) ...)))
(define (captcha-sum stars num)
(define digits (number->digits num))

@ -2,7 +2,7 @@
(provide (rename-out [#%mb #%module-begin]))
(define-macro (#%mb (STARS) (NUMBER ...) ...)
#'(#%module-begin (checksum 'STARS '((NUMBER ...) ...))))
#'(#%module-begin (time (checksum 'STARS '((NUMBER ...) ...)))))
(define (checksum stars intss)
(define (max-min-diff ints) (- (apply max ints) (apply min ints)))

@ -2,7 +2,7 @@
(provide (rename-out [#%mb #%module-begin]))
(define-macro (#%mb (STARS) (NUMBER) ...)
#'(#%module-begin ((if (eq? 'STARS ') dist larger-sum) NUMBER) ...))
#'(#%module-begin (time ((if (eq? 'STARS ') dist larger-sum) NUMBER) ...)))
(define (ring-side r) (* 2 r))
(define (ring-last r) (expt (add1 (ring-side r)) 2))

@ -3,9 +3,9 @@
(provide (rename-out [#%mb #%module-begin]))
(define-macro (#%mb (STARS) (WORD ...) ...)
#'(#%module-begin
(for/sum ([ws (in-list '((WORD ...) ...))]
#:when (no-duplicates? ws #:anagrams? (eq? 'STARS '★★)))
1)))
(time (for/sum ([ws (in-list '((WORD ...) ...))]
#:when (no-duplicates? ws #:anagrams? (eq? 'STARS '★★)))
1))))
(define (sort-chars word)
(sort (string->list (symbol->string word)) char<?))

@ -3,7 +3,7 @@
(provide (rename-out [#%mb #%module-begin]))
(define-macro (#%mb (STARS) (JMP) ...)
#`(#%module-begin
(escape (list->vector '(JMP ...)) 'STARS)))
(time (escape (list->vector '(JMP ...)) 'STARS))))
(define (escape vec stars)
(let/ec exit
@ -12,8 +12,8 @@
(unless (<= 0 pos (sub1 (vector-length vec)))
(exit i))
(define jmp (vector-ref vec pos))
(vector-set! vec pos (if (and (eq? stars '★★) (>= jmp 3))
(sub1 jmp)
(add1 jmp)))
(vector-set! vec pos ((if (and (eq? stars '★★) (>= jmp 3))
sub1
add1) jmp))
(+ pos jmp))))

@ -3,7 +3,7 @@
(provide (rename-out [#%mb #%module-begin]))
(define-macro (#%mb (STARS) (BANK ...))
#`(#%module-begin
(count-redists (list->vector '(BANK ...)) 'STARS)))
(time (count-redists (list->vector '(BANK ...)) 'STARS))))
(define (redist starting-vec)
(define vec (vector-copy starting-vec))

@ -3,8 +3,9 @@
(define-macro (#%mb (STARS) (TOK ...) ...)
#`(#%module-begin
(inst TOK ...) ...
(if (eq? 'STARS ') (max-arg vals) max-seen)))
(time
(inst TOK ...) ...
(if (eq? 'STARS ') (max-arg vals) max-seen))))
(define vals (make-hasheq))
(define (get-val key) (hash-ref! vals key 0))

@ -8,10 +8,10 @@
(define-macro (#%mb STARS-LINE SEXP-LINE ...)
#`(#%module-begin
(if (eq? (process-line STARS-LINE) ')
(score (process-line SEXP-LINE))
(process-line SEXP-LINE #t))
...))
(time (if (eq? (process-line STARS-LINE) ')
(score (process-line SEXP-LINE))
(process-line SEXP-LINE #t))
...)))
(define (process-line line [garbage #f])
(define gchars 0)

@ -11,7 +11,7 @@
(define-macro (#%mb STARS RANGE-IN STR)
#`(#%module-begin
((if (eq? 'STARS ') one-star two-star) RANGE-IN STR)))
(time ((if (eq? 'STARS ') one-star two-star) RANGE-IN STR))))
(define (one-star range-in str)
(define lens (with-input-from-string (string-replace str "," " ")
@ -36,7 +36,7 @@
[len (in-list lens)])
(define posns (for/list ([i (in-range len)])
(modulo (+ current-position i) range-in)))
(for ([val (in-list (map (curry vector-ref vec) posns))]
(for ([val (in-list (map (λ (posn) (vector-ref vec posn)) posns))]
[posn (in-list (reverse posns))])
(vector-set! vec posn val))
(values (+ current-position len skip-size) (add1 skip-size)))

@ -3,7 +3,7 @@
(define-macro (#%mb (STARS) (HEX ...) ...)
#'(#%module-begin
((if (eq? 'STARS ') one-star two-star) (list HEX ...)) ...))
(time ((if (eq? 'STARS ') one-star two-star) (list HEX ...)) ...)))
(define origin '(0 0 0))
(define ne '(1 0 -1)) (define sw '(-1 0 1))

@ -4,17 +4,18 @@
(define-macro (#%mb (STARS) (NUM <-> . NUMS) ...)
#'(#%module-begin
(define g (unweighted-graph/undirected null))
(for-each (curry add-edge! g NUM) (list . NUMS)) ...
(if (eq? 'STARS ')
(programs-in-group g 0)
(number-of-groups g (list NUM ...)))))
(time
(define g (unweighted-graph/undirected null))
(for-each (curry add-edge! g NUM) (list . NUMS)) ...
(if (eq? 'STARS ')
(programs-in-group g 0)
(number-of-groups g (list NUM ...))))))
(define (programs-in-group g x) (length (group-of g x)))
(define (group-of g x)
(define-values (connects _) (dijkstra g x))
(for/list ([(k v) (in-hash connects)]
(for/list ([(k v) (in-mutable-hash connects)]
#:when (integer? v))
k))

@ -6,7 +6,7 @@
(with-pattern ([(DEPTH ...)
(for/list ([id (in-syntax #'(DEPTH: ...))])
(string->number (string-trim (symbol->string (syntax->datum id)) ":")))])
#'(#%module-begin (STARS '(DEPTH ...) '(RANGE ...)))))
#'(#%module-begin (time (STARS '(DEPTH ...) '(RANGE ...))))))
(define (caught? depth range [delay 0])
(zero? (modulo (+ depth delay) (* 2 (sub1 range)))))

@ -4,17 +4,21 @@
(define-macro (#%mb (STARS) (STR) ...)
#`(#%module-begin
((if (eq? 'STARS ') one-star two-star) (format "~a" 'STR)) ...))
(time ((if (eq? 'STARS ') one-star two-star) (format "~a" 'STR))) ...))
(define (knot-hashes str)
(for/list ([i (in-range 128)])
(knot-hash (format "~a-~a" str i))))
(define (one-star str)
(for*/sum ([i (in-range 128)]
[digit (in-list (kh->ints (knot-hash (format "~a-~a" str i))))])
digit))
(for*/sum ([kh (in-list (knot-hashes str))]
[int (in-list (kh->ints kh))])
int))
(define (two-star str)
(define vec (for*/vector ([i (in-range 128)]
[int (in-list (kh->ints (knot-hash (format "~a-~a" str i))))])
(if (= int 1) "#" ".")))
(define vec (for*/vector ([kh (in-list (knot-hashes str))]
[int (in-list (kh->ints kh))])
(if (= int 1) 'used 'empty)))
(define (at-left-edge? idx) (= (modulo idx 128) 0))
(define (at-right-edge? idx) (= (modulo idx 128) 127))
(for/fold ([region 0])
@ -22,11 +26,12 @@
#:unless (number? val))
(let loop ([idx idx])
(cond
[(and (< -1 idx (vector-length vec)) (equal? (vector-ref vec idx) "#"))
[(and (<= 0 idx (sub1 (vector-length vec))) (eq? (vector-ref vec idx) 'used))
(vector-set! vec idx region)
(unless (at-left-edge? idx) (loop (sub1 idx)))
(unless (at-right-edge? idx) (loop (add1 idx)))
(map loop (list (+ idx 128) (- idx 128)))
(loop (+ idx 128))
(loop (- idx 128))
(add1 region)]
[else region]))))
@ -34,7 +39,7 @@
(for*/list ([c (in-string kh)]
[num (in-value (string->number (string c) 16))]
[c (in-string (~r num #:base 2 #:min-width 4 #:pad-string "0"))])
(string->number (string c))))
(if (char=? c #\1) 1 0)))
(define (knot-hash seed-str [range-in 256])
(define ascii-chars (map char->integer (string->list seed-str)))
@ -52,7 +57,7 @@
[len (in-list lens)])
(define posns (for/list ([i (in-range len)])
(modulo (+ current-position i) range-in)))
(for ([val (in-list (map (curry vector-ref vec) posns))]
(for ([val (in-list (map (λ (posn) (vector-ref vec posn)) posns))]
[posn (in-list (reverse posns))])
(vector-set! vec posn val))
(values (+ current-position len skip-size) (add1 skip-size)))

@ -3,26 +3,26 @@
(define-macro (#%mb (STARS) (Generator X starts with NUM) ...)
#`(#%module-begin
(apply STARS '(NUM ...))))
(time (STARS 'NUM ...))))
(define (lower-16-bits x) (bitwise-bit-field x 0 16))
(define (generator-base a b rounds [modulo-a 1] [modulo-b 1])
(for/fold ([a-last a]
[b-last b]
(define (generator-fold start factor mod)
(for/fold ([val start])
([i (in-naturals)]
#:break (and (positive? i) (zero? (modulo val mod))))
(remainder (* factor val) 2147483647)))
(define (generator-base a-start b-start rounds [modulo-a 1] [modulo-b 1])
(for/fold ([a-start a-start]
[b-start b-start]
[sum 0]
#:result sum)
([i (in-range rounds)])
(define a (for/fold ([a a-last])
([i (in-naturals)]
#:break (and (positive? i) (zero? (modulo a modulo-a))))
(remainder (* 16807 a) 2147483647)))
(define b (for/fold ([b b-last])
([i (in-naturals)]
#:break (and (positive? i) (zero? (modulo b modulo-b))))
(remainder (* 48271 b) 2147483647)))
(define a (generator-fold a-start 16807 modulo-a))
(define b (generator-fold b-start 48271 modulo-b))
(values a b (+ sum (if (= (lower-16-bits a) (lower-16-bits b)) 1 0)))))
(define ( a-start b-start) (generator-base a-start b-start 40000000))
(define ( a-start b-start) (generator-base a-start b-start (* 40 1000000)))
(define (★★ a-start b-start) (generator-base a-start b-start 5000000 4 8))
(define (★★ a-start b-start) (generator-base a-start b-start (* 5 1000000) 4 8))

@ -1,3 +1,3 @@
#lang reader "main.rkt" ★★
#lang reader "main.rkt" ★★ ; 336
Generator A starts with 783
Generator B starts with 325