Paste: AoC 2022 Day 18

Author: Kacarott
Mode: factor
Date: Sun, 18 Dec 2022 16:08:05
Plain Text |
! Copyright (C) 2022 Keldan Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel AOC prettyprint splitting math math.parser sets math.vectors
       sequences arrays combinators math.order ;
IN: AOC.2022.18

CONSTANT: dirs { { 0 0 1 } { 0 0 -1 } { 0 1 0 } { 0 -1 0 } { 1 0 0 } { -1 0 0 } }

: parse-input ( input -- seq ) split-lines [ "," split [ dec> ] map ] map ;

: count-adjacent ( seen count elt -- seen count )
    [ pick adjoin ] [ dirs swap '[ _ v+ pick in? ] count ] bi + ;

: part-1 ( input -- result ) parse-input
    HS{ } clone 0 rot [ count-adjacent ] each [ cardinality 6 * ] dip 2 * - ;

: spread? ( seen open limits group elt -- inner? ) {
        { [ [ reach in? ] keep swap ] [ swap adjoin 3drop f ] } ! is open?
        { [ [ reach ] dip dup rot in? ] [ 5drop t ] } ! is wall?
        { [ 2dup swap in? ] [ 5drop t ] } ! seen already?
        { [ dup reach [ first2 between? not ] 2any? ] [ swap adjoin 3drop f ] } ! outside limits
        [ 2dup swap adjoin '[ _ _ _ roll _ swap _ v+ spread? ] dirs swap all? ] ! otherwise
    } cond ;

: fill-gaps ( seen open count limits elt -- seen open count limits )
    [ -rot ] 2dip [ 3dup ] dip HS{ } clone [ swap spread? ] keep swap [ rot ] 3dip ! seen open count limits group ?
    [ [ reach rot ] dip members [ count-adjacent ] each nip swap ]
    [ pickd union! drop ] if ;

: part-2 ( input -- result ) parse-input
    [ HS{ } clone 0 rot [ count-adjacent ] each ]
    [ flip [ [ infimum ] [ supremum ] bi 2array ] map ]
    [ HS{ } clone -roll [ dirs swap '[ _ v+ ] map ] map concat members [ fill-gaps ] each ] tri
    drop nip [ cardinality 6 * ] dip 2 * - ;

MAIN: [ 18 read-day-input [ part-1 . ] [ part-2 . ] bi ]

New Annotation

Summary:
Author:
Mode:
Body: