Last active

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Racket solution to reddit Daily Programmer #173

View advanced-ant.rkt
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
#lang racket
 
; http://www.reddit.com/r/dailyprogrammer/comments/2c4ka3/7302014_challenge_173_intermediate_advanced/
 
(require 2htdp/universe
2htdp/image)
 
(define possible-colors
(list->vector
(map (λ (c) (apply make-color c))
'(
; base black and white
(255 255 255 255)
( 0 0 0 255)
; color brewer qualitative 12
(141 211 199 255)
(255 255 179 255)
(190 186 218 255)
(251 128 114 255)
(128 177 211 255)
(253 180 98 255)
(179 222 105 255)
(252 205 229 255)
(217 217 217 255)
(188 128 189 255)
(204 235 197 255)
(255 237 111 255)
))))
 
; structs
(define-struct ant (position direction))
(define-struct world (grid ant size turns))
(define-struct vec2 (x y) #:transparent)
 
; helpers
(define (vec2-add v1 v2)
(vec2
(+ (vec2-x v1)(vec2-x v2))
(+ (vec2-y v1)(vec2-y v2))))
 
(define (gen-empty-grid m n)
(build-vector m (lambda (y) (make-vector n 0))))
 
(define (gen-initial-world size turns)
(world (gen-empty-grid size size)
(ant (vec2 (/ size 2) (/ size 2))
'N)
size
turns))
 
(define (lookup-state w pos)
(vector-ref (vector-ref (world-grid w) (vec2-x pos)) (vec2-y pos)))
 
 
(define (check-wrap-around xmax ymax pos)
(cond
[(> 0 (vec2-x pos)) (vec2 (sub1 xmax) (vec2-y pos))]
[(> 0 (vec2-y pos)) (vec2 (vec2-x pos) (sub1 ymax))]
[(<= xmax (vec2-x pos)) (vec2 0 (vec2-y pos))]
[(<= ymax (vec2-y pos)) (vec2 (vec2-x pos) 0)]
[else pos]))
 
(define (tick-current-square! w)
(match-define (world grid (ant (vec2 x y) _) _ turns) w)
(define current (vector-ref (vector-ref grid x) y))
(vector-set! (vector-ref grid y) x
(modulo (add1 current)
(vector-length turns))))
 
(define turn
(match-lambda**
; north
(['N 'L] 'W)
(['N 'R] 'E)
; west
(['W 'L] 'S)
(['W 'R] 'N)
; east
(['E 'L] 'N)
(['E 'R] 'S)
; south
(['S 'L] 'E)
(['S 'R] 'W)))
 
(define (input->turn-vector input-string)
(list->vector
(map (compose string->symbol string) (string->list input-string))))
 
 
; movement
(define (tick-world! w)
(define turn-vector (world-turns w))
(define size (world-size w))
; look at the direction the ant is facing
(define movement-modifier
(case (ant-direction (world-ant w))
['N (vec2 0 -1)]
['S (vec2 0 1)]
['W (vec2 -1 0)]
['E (vec2 1 0)]))
; read the next position
(define next-pos
(check-wrap-around size size
(vec2-add
movement-modifier
(ant-position (world-ant w)))))
; turn depending on next position
(define next-direction
(turn (ant-direction (world-ant w))
(vector-ref (world-turns w) (lookup-state w next-pos) )))
; mutate grid in world
(tick-current-square! w )
; update position & direction of ant, return world
(struct-copy world w
[ant (struct-copy ant (world-ant w)
[position next-pos]
[direction next-direction])]))
 
(define (iterate-world w n)
(if (<= 0 n)
(iterate-world (tick-world! w) (sub1 n))
w))
 
(define (world->pic w)
(color-list->bitmap
(reverse
(for/fold ([acc '()])
([row (world-grid w)])
(for/fold ([acc acc])
([n row])
(cons (vector-ref possible-colors n) acc))))
(world-size w) (world-size w)))
 
(define (display-world s)
(lambda (w)
(scale s (world->pic w))))
 
(define (main input-string size scale-factor speed-factor)
(define tick-fn
(lambda (w) (iterate-world w speed-factor)))
(if (> (string-length input-string)
(vector-length possible-colors))
(displayln (~a "String too long. Only " (vector-length possible-colors) " turns allowed."))
(begin
(big-bang
(gen-initial-world size (input->turn-vector input-string))
(on-tick tick-fn)
(on-draw (display-world scale-factor))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.