:- use_module(library(pio)). :- use_module(library(dcg/basics)). :- op(700, xfx, [supports, is_way_above]). :- initialization(main, main). main([FileName|_]) :- input(FileName, Bricks), stack(Bricks, Stacked), support_listing(Stacked, LookDown, LookUp), max_member(MaxN-_-_-_, Bricks), findall(N, (between(0, MaxN, N), can_remove(N, LookDown, LookUp)), Ns), length(Ns, Answer), write(Answer), nl. can_remove(N, LookDown, LookUp) :- BeingSupporteds = LookUp.N, write(N), write("("), write(LookDown.N), write(") supporting "), write(BeingSupporteds), nl, maplist(supported_by_more_than_one(LookDown), BeingSupporteds). supported_by_more_than_one(LookDown, N) :- LookDown.N > 1. % StackedBricks is sorted by decreasing top edge support_listing(StackedBricks, SupportedCount, SupportingMap) :- findall( N=SupportedListLen, ( append(_, [Brick1|Belows], StackedBricks), supported_by(Brick1, Belows, SupportedList), length(SupportedList, SupportedListLen), Brick1 = N-_-_-_), SupportedLists), SupportedCount = brick{}.put(SupportedLists), sort(2, @=<, StackedBricks, StackSortedByBottoms), findall( M=SupportingList, ( append(_, [Brick2|Aboves], StackSortedByBottoms), supporting(Brick2, Aboves, SupportingList), Brick2 = M-_-_-_), SupportingLists), SupportingMap = brick{}.put(SupportingLists). % Aboves need to be sorted by increasing bot edge supporting(_Brick, [], []). supporting(Brick, [Above|_], []) :- Above is_way_above Brick, !. supporting(Brick, [Above|Aboves], Supportings) :- supporting(Brick, Aboves, NextSupportings), ( Brick supports Above -> Above = N-_-_-_, Supportings = [N|NextSupportings] ; Supportings = NextSupportings). % Belows need to be sorted decreasing by top edge supported_by(_Brick, [], []). supported_by(Brick, [Below|_], []) :- Brick is_way_above Below, !. supported_by(Brick, [Below|Belows], SupportedBy) :- supported_by(Brick, Belows, NextSupportedBy), ( Below supports Brick -> Below = N-_-_-_, SupportedBy = [N|NextSupportedBy] ; SupportedBy = NextSupportedBy). is_way_above(_-_-_-(Z2bot-_), _-_-_-(_-Z1top)) :- Z2bot > Z1top + 1. supports(Brick1, Brick2) :- overlap(Brick1, Brick2), Brick1 = _-_-_-(_-Z1top), Brick2 = _-_-_-(Z2bot-_), Z2bot =:= Z1top + 1. stack(Bricks, StackedBricks) :- empty_heap(H0), foldl(stack1, Bricks, H0, Heap), heap_to_list(Heap, HeapList), maplist([_-Brick, Brick]>>(true), HeapList, StackedBricks). stack1(Brick, Heap, NewHeap) :- ( max_of_heap(Heap, OldZtop, OldTop), overlap(Brick, OldTop) ; empty_heap(Heap), OldZtop is 0), Brick = N-X-Y-(Zbot-Ztop), NewZbot is OldZtop + 1, NewZtop is NewZbot + (Ztop - Zbot), add_to_maxheap(Heap, NewZtop, N-X-Y-(NewZbot-NewZtop), NewHeap), !. stack1(Brick, Heap, NewHeap) :- get_from_maxheap(Heap, LastZtop, LastTopBrick, HeapWithoutTop), stack1(Brick, HeapWithoutTop, NewHeapWithoutTop), add_to_maxheap(NewHeapWithoutTop, LastZtop, LastTopBrick, NewHeap). overlap(_-(Xa1-Xa2)-(Ya1-Ya2)-_, _-(Xb1-Xb2)-(Yb1-Yb2)-_) :- Xa1 =< Xb2, Xa2 >= Xb1, Ya1 =< Yb2, Ya2 >= Yb1. % input parsing stuff below. Brick indexing is for debugging. input(FileName, SortedBricks) :- phrase_from_file(bricks(0, Bricks), FileName), sort(2, @=<, Bricks, SortedBricks). bricks(_, []) --> eos, !. bricks(N, [Line|Lines]) --> {Next is N+1}, brick(N, Line), bricks(Next, Lines). brick(N, N-(X1-X2)-(Y1-Y2)-(Z1-Z2)) --> number(X1), ",", number(Y1), ",", number(Z1), "~", number(X2), ",", number(Y2), ",", number(Z2), "\n". % maxheap wrapper. PriX = -Pri, which is the Ztop max_of_heap(H, Pri, Key) :- min_of_heap(H, PriX, Key), Pri is -PriX. add_to_maxheap(H0, Pri, Key, H) :- PriX is -Pri, add_to_heap(H0, PriX, Key, H). get_from_maxheap(H0, Pri, Key, H) :- get_from_heap(H0, PriX, Key, H), Pri is -PriX. % Can probably do 2 maps, one by top edges and one by bottom edges and lookup