From Wikipedia:
GEORGE (General Order Generator) is a programming language invented by Charles Leonard Hamblin in 1957. It was designed around a push-down pop-up stack for arithmetic operations, and employed reverse Polish notation. The language included loops, subroutines, conditionals, vectors, and matrices.
A bit from the readme appreciating concatenative programming:
The Joy language introduced concatenative functional programming. This generally means a stack based virtual machine, and a program consisting of words which are functions taking an input stack and returning an output stack. The natural syntax that results is postfix. Over a very long time I have come to feel that syntax gets in between me and the power in a language. Postfix is the least syntax possible.
There are several reasons I like the concatenative style of programming:
Function composition is concatenation.
Pipelining values through functions to get new values is the most natural idiom.
Functions are applied from left to right instead of inside out.
Support for multiple return values comes for free.
No need for operator precedence.
Fewer delimiters are required:
(Note: Sapf is inspired by, but is not purely a concatenative language because it has lexical variables.)
When I am programming interactively, I most often find myself in the situation where I have a value and I want to transform it to something else. The thing to do is apply a function with some parameters. With concatenative programming this is very natural. You string along several words and get a new value.
The given Uiua example (mercifully given using words rather than the symbols):
[3 4 5 10 23]
divide length on /+
For all the talk about "forward" it's uncomfortable to me how the Uiua evaluation within a line happens backward.
An equivalent in Factor, where keep is close to on:
{ 3 4 5 10 23 }
[ sum ] keep length /
But this pattern of doing two things in sequence to the same item is common enough that bi is handy:
{ 3 4 5 10 23 }
[ sum ] [ length ] bi /
Day 6
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/06/input.txt" utf8 file-lines ;
: all-locations ( rows -- pairs )
dimension <coordinate-matrix> concat ;
: guard-location ( rows -- pair )
[ all-locations ] keep
'[ _ matrix-nth "<>^v" in? ] find nip ;
TUPLE: state location char ;
C: <state> state
: guard-state ( rows -- state )
[ guard-location ]
[ dupd matrix-nth ] bi <state> ;
: faced-location ( state -- pair )
[ char>> H{
{ CHAR: > { 0 1 } }
{ CHAR: v { 1 0 } }
{ CHAR: < { 0 -1 } }
{ CHAR: ^ { -1 0 } }
} at ] [ location>> ] bi v+ ;
: off-grid? ( rows location -- ? )
[ dimension ] dip
[ v<= vany? ] keep
{ 0 0 } v< vany? or ;
: turn ( state -- state' )
[ location>> ] [ char>> ] bi
H{
{ CHAR: > CHAR: v }
{ CHAR: v CHAR: < }
{ CHAR: < CHAR: ^ }
{ CHAR: ^ CHAR: > }
} at <state> ;
: obstacle? ( rows location -- ? )
swap matrix-nth CHAR: # = ;
: guard-step ( rows state -- state' )
swap over faced-location
{
{ [ 2dup off-grid? ] [ 2nip f <state> ] }
{ [ [ obstacle? ] keep-under ] [ drop turn ] }
[ swap char>> <state> ]
} cond ;
: walk-out ( rows state -- trail )
[
[ 2dup location>> off-grid? ] [
dup location>> ,
dupd guard-step
] until
] { } make 2nip ;
: part1 ( -- n )
get-input dup guard-state walk-out cardinality ;
: (walk-loops?) ( visited rows state -- looped? )
dupd guard-step
2dup location>> off-grid? [ 3drop f ] [
pick dupd in? [ 3drop t ] [
pick dupd adjoin (walk-loops?)
] if
] if ;
: walk-loops? ( rows -- looped? )
dup guard-state
[ HS{ } clone ] 2dip
pick dupd adjoin (walk-loops?) ;
: obstacle-candidates ( rows -- pairs )
[ guard-location ]
[ dup guard-state walk-out members ] bi remove ;
: part2 ( -- n )
get-input dup obstacle-candidates
[ CHAR: # spin deep-clone [ matrix-set-nth ] keep walk-loops? ] with count ;
Slow and dumb gets it done! I may revisit this when I give up on future days.
spoiler
TUPLE: equation value numbers ;
C: <equation> equation
: get-input ( -- equations )
"vocab:aoc-2024/07/input.txt" utf8 file-lines [
split-words unclip but-last string>number
swap [ string>number ] map <equation>
] map ;
: possible-quotations ( funcs numbers -- quots )
dup length 1 -
swapd all-selections
[ unclip swap ] dip
[ zip concat ] with map
swap '[ _ prefix >quotation ] map ;
: possibly-true? ( funcs equation -- ? )
[ numbers>> possible-quotations ] [ value>> ] bi
'[ call( -- n ) _ = ] any? ;
: solve ( funcs -- n )
get-input
[ possibly-true? ] with filter
[ value>> ] map-sum ;
: part1 ( -- n )
{ + * } solve ;
: _|| ( m n -- mn )
[ number>string ] bi@ append string>number ;
: part2 ( -- n )
{ + * _|| } solve ;
Nothing smart to see here. I may revisit this when I give up on future days.
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/06/input.txt" utf8 file-lines ;
: all-locations ( rows -- pairs )
dimension <coordinate-matrix> concat ;
: guard-location ( rows -- pair )
[ all-locations ] keep
'[ _ matrix-nth "<>^v" in? ] find nip ;
TUPLE: state location char ;
C: <state> state
: guard-state ( rows -- state )
[ guard-location ]
[ dupd matrix-nth ] bi <state> ;
: faced-location ( state -- pair )
[ char>> H{
{ CHAR: > { 0 1 } }
{ CHAR: v { 1 0 } }
{ CHAR: < { 0 -1 } }
{ CHAR: ^ { -1 0 } }
} at ] [ location>> ] bi v+ ;
: off-grid? ( rows location -- ? )
[ dimension ] dip
[ v<= vany? ] keep
{ 0 0 } v< vany? or ;
: turn ( state -- state' )
[ location>> ] [ char>> ] bi
H{
{ CHAR: > CHAR: v }
{ CHAR: v CHAR: < }
{ CHAR: < CHAR: ^ }
{ CHAR: ^ CHAR: > }
} at <state> ;
: obstacle? ( rows location -- ? )
swap matrix-nth CHAR: # = ;
: guard-step ( rows state -- state' )
swap over faced-location
{
{ [ 2dup off-grid? ] [ 2nip f <state> ] }
{ [ [ obstacle? ] keep-under ] [ drop turn ] }
[ swap char>> <state> ]
} cond ;
: walk-out ( rows state -- trail )
[
[ 2dup location>> off-grid? ] [
dup location>> ,
dupd guard-step
] until
] { } make 2nip ;
: part1 ( -- n )
get-input dup guard-state walk-out cardinality ;
: (walk-loops?) ( visited rows state -- looped? )
dupd guard-step
2dup location>> off-grid? [ 3drop f ] [
pick dupd in? [ 3drop t ] [
pick dupd adjoin (walk-loops?)
] if
] if ;
: walk-loops? ( rows -- looped? )
dup guard-state
[ HS{ } clone ] 2dip
pick dupd adjoin (walk-loops?) ;
: obstacle-candidates ( rows -- pairs )
[ guard-location ]
[ dup guard-state walk-out members ] bi remove ;
: part2 ( -- n )
get-input dup obstacle-candidates
[ CHAR: # spin deep-clone [ matrix-set-nth ] keep walk-loops? ] with count ;
Day 5
spoiler
: get-input ( -- rules updates )
"vocab:aoc-2024/05/input.txt" utf8 file-lines
{ "" } split1
"|" "," [ '[ [ _ split ] map ] ] bi@ bi* ;
: relevant-rules ( rules update -- rules' )
'[ [ _ in? ] all? ] filter ;
: compliant? ( rules update -- ? )
[ relevant-rules ] keep-under
[ [ index* ] with map first2 < ] with all? ;
: middle-number ( update -- n )
dup length 2 /i nth-of string>number ;
: part1 ( -- n )
get-input
[ compliant? ] with
[ middle-number ] filter-map sum ;
: compare-pages ( rules page1 page2 -- <=> )
[ 2array relevant-rules ] keep-under
[ drop +eq+ ] [ first index zero? +gt+ +lt+ ? ] if-empty ;
: correct-update ( rules update -- update' )
[ swapd compare-pages ] with sort-with ;
: part2 ( -- n )
get-input dupd
[ compliant? ] with reject
[ correct-update middle-number ] with map-sum ;
: get-input ( -- rules updates )
"vocab:aoc-2024/05/input.txt" utf8 file-lines
{ "" } split1
"|" "," [ '[ [ _ split ] map ] ] bi@ bi* ;
: relevant-rules ( rules update -- rules' )
'[ [ _ in? ] all? ] filter ;
: compliant? ( rules update -- ? )
[ relevant-rules ] keep-under
[ [ index* ] with map first2 < ] with all? ;
: middle-number ( update -- n )
dup length 2 /i nth-of string>number ;
: part1 ( -- n )
get-input
[ compliant? ] with
[ middle-number ] filter-map sum ;
: compare-pages ( rules page1 page2 -- <=> )
[ 2array relevant-rules ] keep-under
[ drop +eq+ ] [ first index zero? +gt+ +lt+ ? ] if-empty ;
: correct-update ( rules update -- update' )
[ swapd compare-pages ] with sort-with ;
: part2 ( -- n )
get-input dupd
[ compliant? ] with reject
[ correct-update middle-number ] with map-sum ;
spoiler
: get-input ( -- rows )
"vocab:aoc-2024/04/input.txt" utf8 file-lines ;
: verticals ( rows -- lines )
[ dimension last [0..b) ] keep cols ;
: slash-origins ( rows -- coords )
dimension
[ first [0..b) [ 0 2array ] map ] [
first2 [ 1 - ] [ 1 (a..b] ] bi*
[ 2array ] with map
] bi append ;
: backslash-origins ( rows -- coords )
dimension first2
[ [0..b) [ 0 2array ] map ]
[ 1 (a..b] [ 0 swap 2array ] map ] bi* append ;
: slash ( rows origin -- line )
first2
[ 0 [a..b] ]
[ pick dimension last [a..b) ] bi* zip
swap matrix-nths ;
: backslash ( rows origin -- line )
[ dup dimension ] dip first2
[ over first [a..b) ]
[ pick last [a..b) ] bi* zip nip
swap matrix-nths ;
: slashes ( rows -- lines )
dup slash-origins
[ slash ] with map ;
: backslashes ( rows -- lines )
dup backslash-origins
[ backslash ] with map ;
: word-count ( line word -- n )
dupd [ reverse ] dip
'[ _ subseq-indices length ] bi@ + ;
: part1 ( -- n )
get-input
{ [ ] [ verticals ] [ slashes ] [ backslashes ] } cleave-array concat
[ "XMAS" word-count ] map-sum ;
: origin-adistances ( rows origins line-quot: ( rows origin -- line ) -- origin-adistances-assoc )
with zip-with
"MAS" "SAM" [ '[ [ _ subseq-indices ] map-values ] ] bi@ bi append
harvest-values
[ [ 1 + ] map ] map-values ; inline
: a-coords ( origin-adistances coord-quot: ( adistance -- row-delta col-delta ) -- coords )
'[ first2 [ @ 2array v+ ] with map ] map-concat ; inline
: slash-a-coords ( rows -- coords )
dup slash-origins [ slash ] origin-adistances
[ [ 0 swap - ] keep ] a-coords ;
: backslash-a-coords ( rows -- coords )
dup backslash-origins [ backslash ] origin-adistances
[ dup ] a-coords ;
: part2 ( -- n )
get-input [ slash-a-coords ] [ backslash-a-coords ] bi
intersect length ;
Better viewed on GitHub.
A bigger discussion on Hacker News: https://news.ycombinator.com/item?id=43751076