Andy

joined 2 years ago
MODERATOR OF
1
submitted 6 days ago* (last edited 5 days ago) by Andy to c/concatenative
 

Copied from the release notes:

We're starting with a new release approach, these files will stay available permanently in contrast to the latest nightly.

We now recommend most users to stick to 0.0.0-alpha releases instead of nightly-latest.

This current release is based on commit a089cf2 from the 6th of January 2025. These files are identical to nightly-latest published on the 7th of January 2025.


EDIT: A whole lot more detail in the new 0.0.0-alpha2-rolling release

[–] Andy 1 points 2 weeks ago

It's been a while, but my clumsy adding of a comment to the buffer is unnecessary, given zle -M, which will display a message outside of the buffer. So here's an updated version:

# -- Run input if single line, otherwise insert newline --
# Key: enter
# Credit: https://programming.dev/comment/2479198
.zle_accept-except-multiline () {
  if [[ $BUFFER != *$'\n'* ]] {
    zle .accept-line
    return
  } else {
    zle .self-insert-unmeta
    zle -M 'Use alt+enter to submit this multiline input'
  }
}
zle -N       .zle_accept-except-multiline
bindkey '^M' .zle_accept-except-multiline  # Enter

# -- Run input if multiline, otherwise insert newline --
# Key: alt+enter
# Credit: https://programming.dev/comment/2479198
.zle_accept-only-multiline () {
  if [[ $BUFFER == *$'\n'* ]] {
    zle .accept-line
  } else {
    zle .self-insert-unmeta
  }
}
zle -N         .zle_accept-only-multiline
bindkey '^[^M' .zle_accept-only-multiline  # Enter
[–] Andy 1 points 3 weeks ago

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 /
 

Discussion on lobsters

1
Derangements | Re: Factor (re.factorcode.org)
submitted 1 month ago by Andy to c/concatenative
[–] Andy 1 points 1 month ago

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 ;

[–] Andy 1 points 1 month ago* (last edited 1 month ago)

Slow and dumb gets it done! I may revisit this when I give up on future days.

[–] Andy 3 points 1 month ago (1 children)

Factor

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 ;

[–] Andy 1 points 1 month ago* (last edited 1 month ago)

Nothing smart to see here. I may revisit this when I give up on future days.

[–] Andy 1 points 1 month ago* (last edited 1 month ago) (1 children)

Factor

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 ;

3
Zen of Factor | Re: Factor (re.factorcode.org)
submitted 2 months ago by Andy to c/concatenative
3
Watching Code | Re: Factor (re.factorcode.org)
submitted 2 months ago by Andy to c/concatenative
[–] Andy 1 points 2 months ago

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 ;

on GitHub

[–] Andy 5 points 2 months ago

Factor

: 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 ;

on GitHub

[–] Andy 3 points 2 months ago* (last edited 1 month ago)

Factor

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.

[–] Andy 1 points 2 months ago* (last edited 1 month ago)

Day 4

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

[–] Andy 2 points 2 months ago

More Factor solutions for the first 3 days (at time of comment) from okflo, on sourcehut.

14
submitted 2 months ago* (last edited 2 months ago) by Andy to c/concatenative
 

Alright, show me I'm not the only one in this community, and show off some solutions!

Here's my Day 1 solution in Factor (minus imports):

spoiler

: get-input ( -- left-list right-list )
  "aoc-2024.01" "input.txt" vocab-file-lines
  [ split-words harvest ] map unzip
  [ [ string>number ] map ] bi@ ;

: part1 ( -- n )
  get-input
  [ sort ] bi@
  [ - abs ] 2map-sum ;

: part2 ( -- n )
  get-input
  histogram
  '[ dup _ at 0 or * ] map-sum ;

Sadly, Factor doesn't get highlighted properly here, so here it is again as an image:

spoiler

syntax-highlighted screenshot of the code above

I probably won't last the week, but what solutions I do have will be up on GitHub.

6
NeoHaskell (neohaskell.org)
submitted 2 months ago by Andy to c/concatenative
 

This example is my justification for posting it here:

"NeoHaskell is cool"
  |> Text.toWordList
  |> List.map Text.length
  |> List.map (\x -> x * x)
  |> List.takeIf Int.isEven
view more: next ›