:- lib(fd).
:- lib(fd_global). % Defines lexico_le
:- lib(propia).

:- local struct( contents(glass,plastic,steel,wood,copper) ).
:- local struct( bin(colour,capacity,contents:contents) ).

tr_col(red, 3).
tr_col(green, 2).
tr_col(blue, 1).

:- local macro(no_macro_expansion(blue)/0, tr_col/2, []).
:- local macro(no_macro_expansion(green)/0, tr_col/2, []).
:- local macro(no_macro_expansion(red)/0, tr_col/2, []).

 
/* Data */

capacity(blue, 1). 
capacity(green,4).
capacity(red,  3).

colour_wood_cap(blue, Cap) :- capacity(blue,Cap).
colour_wood_cap(green,2).
colour_wood_cap(red,1).

/* Program */
test(M) :-
        ( (N=1 ; N=2 ; N= 3 ; N=4), length(Bins,N) ) infers most,
        findall(Bins,solve(Bins),List),
        length(List,M).


solve(Bins) :-
    Demand = contents with [glass:1,
			    plastic:2,
			    steel:1,
			    wood:3,
			    copper:2],
    bin_setup(Demand,Bins),
    remove_symmetry(Bins),
    bin_label(Bins).


/*******   Setting Up the Bin Constraints ********/


bin_setup(Demand,[]) :- 
        all_zeroes(Demand).
bin_setup(Demand,[Bin|Bins]) :-
        constrain_bin(Bin),
        reduce_demand(Demand,Bin,RemainingDemand),
        bin_setup(RemainingDemand,Bins).

all_zeroes( contents with [glass:0,
                           plastic:0,
                           wood:0,
                           steel:0,
                           copper:0]).

reduce_demand( contents with [glass:G,
                              plastic:P,
                              wood:W,
                              steel:S, 
                              copper:C],
               bin with [glass:BG,
                         plastic:BP,
                         wood:BW,
                         steel:BS, 
                         copper:BC],
               contents with [glass:RG,
                              plastic:RP,
                              wood:RW,
                              steel:RS, 
                              copper:RC] ) :-
               RG #= G - BG,
               RP #= P - BP,
               RW #= W - BW,
               RS #= S - BS,
               RC #= C - BC.

/*****  Constraints on a Bin  ***********/


constrain_bin(bin with [colour:Col,capacity:Cap,contents:C]) :-
        colour_capacity_cons(Col,Cap),
        capacity_constraint(Cap,C),
        contents_constraints(C),
        colour_constraints(Col,C).


colour_capacity_cons(Col,Cap) :-
        capacity(Col,Cap) infers ac.

contents_constraints(contents with [glass:G,plastic:P,wood:W,copper:C]) :-
        requires(W,P),
        exclusive(G,C),
        exclusive(C,P).

colour_constraints(Col,contents with wood:W) :-
        colour_wood_cap(Col,WCap) infers ac,
        WCap #>= W.


capacity_constraint(Cap, contents with [glass:G,
                                   plastic:P,
                                   steel:S, 
                                   wood:W,
                                   copper:C]) :-
        G #>= 0, P #>= 0, S #>= 0, W #>= 0, C #>= 0,
        G+P+W+S+C #> 0,
        Cap #>= G+P+W+S+C.
        
requires(W,P) :-
        W #> 0 #=> P #> 0.

exclusive(X,Y) :-
        X #= 0 #\/ Y #= 0.


/*******   Symmetries   ***********/


remove_symmetry(Bins) :-
        ( fromto(Bins,[B1,B2|Rest],[B2|Rest],[_Last])
        do
            lex_ord(B1,B2)
        ).

/*
lex_ord(bin with [colour:Col1,contents:Conts1],
        bin with [colour:Col2,contents:Conts2]) :-
        colour_map(Col1,Int1) infers ac,
        colour_map(Col2,Int2) infers ac,
        term_variables(Conts1,Vars1),
        term_variables(Conts2,Vars2),
        lexico_le([Int1|Vars1],[Int2|Vars2]).

colour_map(blue,1).
colour_map(green,2).
colour_map(red,3).
*/

/******   Search    ************/


bin_label(Bins) :-
        ( foreach(bin with colour:C,Bins) do indomain(C) ),
        term_variables(Bins,Vars),
        labeleff(Vars).

labeleff(Vars) :-
        ( fromto(Vars,InVars,OutVars,[]) 
        do
            deleteff(Var,InVars,OutVars),
            indomain(Var)
        ).

/*
colour_constraints(ColourVar,contents with wood:Qty) :-
        findall( Col-Cap,
                 colour_wood_cap(Col,Cap),
                 Pairs
               ),
        ( foreach(Col-Cap,Pairs),
          param(ColourVar,Qty)
        do
            col_cons(Cap,Col,ColourVar,Qty)
        ).


col_cons(Cap,Col,ColourVar,Qty) :-
        ColourVar #= Col #=> Qty #<= Cap.
*/

/*
colour_capacity_cons(Col,Cap) :-
    ( is_domain(Cap) -> true ; Cap #>= 0 ),
    col_cap_cons(Col,Cap).

col_cap_cons(Col,Cap) :-        
    ( nonvar(Col) -> capacity(Col,Cap) ;
      var(Col) ->  var_col_cap(Col,Cap)
    ).
          
var_col_cap(Col, Cap) :-
    mindomain(Cap,MinC),
    (MinC > 1 ->
        Col #\= blue,
        (MinC > 3 ->
            Col = green
        ;
            suspend(capacity(Col, Cap), 3, (Col, Cap)->inst)
        )
    ;
        suspend(col_cap_cons(Col, Cap), 3, [Col->inst, Cap->min])
    ).
*/

 
lex_ord(Bin1,Bin2) :-
       term_variables(Bin1,V1),
       term_variables(Bin2,V2),
       lexico_le(V1,V2).