Paste: AoC 2022 day 13

! Copyright (C) 2022 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.smart sorting math.vectors match arrays vectors grouping aoc math math.order sequences peg.ebnf multiline lists math.parser kernel
 sequences.extras sequences.deep ;
IN: aoc2022-13

EBNF: (parse) [=[
  n = [0-9]+ => [[ dec> ]]
  list = "["~ ((list|n) ","*~)* "]"~
]=]

: test-input ( -- seq )
  P" work/aoc2022-13/input.txt" load-file ;

: up ( x -- seq )
  dup sequence?
  [ 1vector ]
  unless ;

: first-cmp ( seq -- <=> )
  [ +eq+ = not ] filter
  [ length 0 > ]
  [ first ]
  [ drop +eq+ ]
  smart-if ;

MATCH-VARS: ?val ;
DEFER: compare

: (list-compare) ( x x -- x )
  [ up ] bi@ [ compare ] 2map first-cmp ;

: list-compare ( x x -- x )
    [ (list-compare) ] [ [ up ] bi@ [ length ] bi@ <=> ] 2bi 2array
    {
      { { +eq+ +lt+ } [ +lt+ ] }
      { { +eq+ +eq+ } [ +eq+ ] }
      { { +eq+ +gt+ } [ +gt+ ] }
      { { +lt+ ?val } [ +lt+ ] }
      { { +gt+ ?val } [ +gt+ ] }
    } match-cond ;

: compare ( seq seq -- <=> )
  2dup [ number? ] bi@ and
  [ <=> ]
  [ list-compare ]
  if ; inline recursive

: parse ( -- seq )
  test-input
  harvest [ (parse) ] map ;


:: part1 ( -- n )
  parse
  [ <evens> ] [ <odds> ] bi
  [ >vector ] bi@ :> ( l r )
  l r [ compare ] 2map :> compare-list
  compare-list
  +lt+ swap indices
  1 v+n sum ;

: mycompare ( obj1 obj2 -- <=> )
  compare
;

: part2 ( -- n )
  parse
  V{ V{ V{ 2 } } V{ V{ 6 } } } append
  [ mycompare ] sort
  [ V{ V{ 2 } }  swap index 1 + ] [ V{ V{ 6 } } swap index 1 + ] bi
  *
  ;