Declaratieve Talen/oplossingenStenen

Een eerste oplossing

--Nick.dewaele (overleg) 31 dec 2017 23:03 (CET)

Opmerking: zie ook de overlegpagina voor deze pagina.

emptySymbol(#).
example([[X,c,c,X], [a,c,c,a], [a,c,c,a]]) :- emptySymbol(X).

% predicaat voor vraag 1: maakrechthoeken(Matrix, Res).
% predicaat voor vraag 2: plan(Matrix, Res).

% === vraag 1 ====
% ================

% geeft alle kleuren van de regenboog die in de opgegeven lijst voorkomen
colours(ListOfLists, Res) :-
    findall(E, (
        member(List, ListOfLists),
        member(E, List),
        % het lege symbool behoort niet tot de regenboog
        \+ emptySymbol(E)
    ), Flattened),
    sort(Flattened, Res). % verwijdert dubbels

% geeft een index X-Y van Elem in de Matrix
getIndex(Elem, Matrix, X, Y) :-
    nth1(Y, Matrix, L),
    nth1(X, L, Elem).

% geeft een lijst van alle kleuren met alle posities X-Y waar deze kleuren
% voorkomen in de matrix
allIndices(Matrix, Res) :-
    colours(Matrix, Colours),
    findall(Colour-Indices, (
        member(Colour, Colours),
        findall(X-Y, (
            getIndex(Colour, Matrix, X, Y)
        ), Indices)
    ), Res).

constructRectanglesFromIndices(ColoursIndices, Res) :-
    findall(Colour-rhk(X1,X2,Y1,Y2), (
        member(Colour-[X1-Y1|T], ColoursIndices),
        reverse([X1-Y1|T], [X2-Y2|_])
    ), Res).

% antwoord op vraag 1
maakrechthoeken(Matrix, Res) :-
    allIndices(Matrix, Indices),
    constructRectanglesFromIndices(Indices, Res).

% ==== vraag 2 =====
% ==================

between(A,LowerBound, UpperBound) :- A >= LowerBound, A =< UpperBound.

% waar als er een van de X-Y koppels in de opgegeven rechthoek ligt
anyInside(Locations, rhk(X1,X2,Y1,Y2)) :-
    member(X-Y, Locations),
    between(X, X1, X2),
    between(Y, Y1, Y2),
    !.    

% maak een lijst van termen after(Kleur, Kleuren), zodat Kleur na Kleuren
% gelegd moet worden
mkPrecedenceGraph(Matrix, Res) :-
    allIndices(Matrix, Indices),
    constructRectanglesFromIndices(Indices, Rects),
    findall(after(Colour, Colours), (
        % neem een kleur en zijn indices
        member(Colour-Ind, Indices),
        findall( Col2, (
            % en kijk of die kleur in een andere rechthoek ligt
            member(Col2-Rect, Rects),
            Col2 \= Colour,
            anyInside(Ind, Rect)
        ), Colours)
    ), Res).

% Met een 'precedence graph' zou je in principe een vrij snel algoritme kunnen
% schrijven (toch zeker polynomiaal, of niet?)... als ik nu eens wist hoe dat moest...
% Dan backtracken we maar (een van de voordelen van Prolog)
backtrack(UsedColours, Graph, Path) :-
    select(after(Colour, Prereq), Graph, ReducedGraph),
    isSubset(Prereq, UsedColours),
    backtrack([Colour|UsedColours], ReducedGraph, Path).
backtrack(UsedColours, [], Path) :- reverse(UsedColours, Path).

% antwoord op vraag 2
plan(Matrix, Path) :-
    mkPrecedenceGraph(Matrix, Graph),
    backtrack([], Graph, Path).

isSubset(S, U) :-
    \+ (
        member(X, S),
        \+ member(X, U)
    ).