! day 5 : new-constraint ( constraints before after -- constraints ) [ pick index not and ] curry rot [ swapd set-at ] keep ; : change-constraint ( constraints before after -- constraints ) [ pick index not and ] curry rot [ [ compose ] with change-at ] keep ; : add-constraint ( constraints before after -- constraints ) 2over swap at [ change-constraint ] [ new-constraint ] if ; : get-constraint ( constraints pg -- constraint ) swap at [ [ ] ] unless* ; : try-constraint ( constraints cur befores -- ? ) [ get-constraint ] dip t rot call( befores ? -- befores ? ) nip ; : manual-matches? ( constraints manual -- ? ) t [ [ [ length 0 > ] dip and ] 2check ] [ drop unclip-last swap 3dup try-constraint nipd ] while 2nip ; : find-middle ( seq -- middle ) [ length 1 - 2 / ] keep nth ; : parse-day-five-input ( string -- constraints manuals ) split-lines [ empty? ] split-when first2 [ H{ } clone [ "|" split first2 add-constraint ] reduce ] dip [ "," split ] map ; : solve-day-five-part-one ( constraints manuals -- n ) [ manual-matches? ] with filter [ find-middle dec> ] map sum ; ! 1|2 ! 5|10 ! 2|5 ! ! 5,2,10,1 [] (things inside [] are verified) ! {5,2,10},1 [] (1 must come before 2) ! 1,5,2,10 [] ! {1,5,2},10 [] (10 is good) ! 1,5,2 [10] ! {1,5},2 [10] (2 must come before 5) ! 2,1,5 [10] ! {2,1},5 [10] (5 is good) ! 2,1 [5,10] ! {2},1 [5,10] (1 must come before 2) ! 1,2 [5,10] ! {1},2 [2,5,10] (2 is good) ! 1 [2,5,10] ! {},1 [2,5,10] (1 is good) ! [1,2,5,10] : *, ( elt -- ) building get reverse! [ push ] keep reverse! drop ; : correct-manual ( constraints manual -- manual ) [ [ dup length 0 > ] [ unclip-last [ swap try-constraint ] 3check [ *, ] [ prefix ] if ] while 2drop ] { } make ; : solve-day-five-part-two ( constraints manuals -- n ) dupd [ manual-matches? ] with reject [ correct-manual ] with map [ find-middle dec> ] map sum ;