Paste: aoc13

Author: jon
Mode: factor
Date: Thu, 13 Dec 2018 22:51:19
Plain Text | 
CONSTANT: angle-+ H{
  { 0 { { 0 -1 } { 1 0 } } }
  { 1 { { 1 0 } { 0 1 } } }
  { 2 { { 0 1 } { -1 0 } } }
}

CONSTANT: angle-\ H{
  { { 0 -1 } { -1 0 } }
  { { 1 0 } { 0 1 } }
  { { 0 1 } { 1 0 } }
  { { -1 0 } { 0 -1 } }
}

CONSTANT: angle-/ H{
  { { 0 -1 } { 1 0 } }
  { { 1 0 } { 0 -1 } }
  { { 0 1 } { -1 0 } }
  { { -1 0 } { 0 1 } }
}

: move ( map wagon -- wagon' )
dup pos>> rot at {
  { CHAR: + [ dup cnt>> angle-+ at [ v.m ] curry change-dir
              [ 1 + 3 mod ] change-cnt ] }
  { CHAR: / [ [ angle-/ at ] change-dir ] }
  { CHAR: \ [ [ angle-\ at ] change-dir ] }
  [ drop ]
} case dup dir>> [ v+ ] curry change-pos ;

TUPLE: wagon pos dir cnt ;
C: <wagon> wagon
CONSTANT: wagons H{
  { CHAR: < { -1 0 } }
  { CHAR: > { 1 0 } }
  { CHAR: ^ { 0 -1 } }
  { CHAR: v { 0 1 } }
}
"/tmp/input" ascii file-lines
[ [ 2array swap 2array ] curry map-index ] map-index
concat
[
 [ wagons at nip ] assoc-filter
 [ first2 wagons at 0 <wagon> ] map
] [ [ { 
    { [ dup { CHAR: > CHAR: <  } member? ] [ drop CHAR: - ] }
    { [ dup { CHAR: ^ CHAR: v  } member? ] [ drop CHAR: | ] }
    [ ] } cond
] assoc-map >hashtable ] bi swap
f 
[ over [ pos>> ] map duplicates empty? ]
[ 
 [ dup [ pos>> ] sort-with ] when-empty
 pick swap unclip-slice swapd move drop     
] while drop nip [ pos>> ] map duplicates .

Annotation: part2

Author: jon
Mode: factor
Date: Thu, 13 Dec 2018 23:04:03
Plain Text | 
! replace the main loop above with this one
[ 2dup [ length 1 = ] [ empty? ] bi* and ]
[ 
 [ dup [ pos>> ] sort-with ] when-empty
 pick swap unclip-slice swapd move drop
 over [ pos>> ] map duplicates pick swap [ [ pos>> ] dip member? ] curry filter 
 [ without ] curry bi@
] until drop nip first .

New Annotation

Summary:
Author:
Mode:
Body: