%% CMPU-245, Spring 2011
%% Map Coloring Problem in PROLOG
%% April 12-14, 2011

%%  select(X, Listy, Remnants)
%% ----------------------------------------------------------
%%  Holds if removing one occurrence of X from Listy yields Remnants.
%%  Try: select(1, [1,2,3,1,2,3], Rs).

%%  Base Case:  Select first element of list (which is X)

select(X, [X|Xs], Xs).

%%  Recursive Case:  Ignore first element; select X from rest of list

select(X, [Y|Ys], [Y|Zs]) :- select(X,Ys,Zs).

%%  Try:  select(X, [1,2,3,4], Ys)  .. use semi-colon to see multiple answers


%%  member(X, Listy)
%% ----------------------------------------------------------
%%  Holds if X is an element of Listy

%%  Base Case:  X is the first element of the list

member(X, [X|_Xs]).

%%  Recursive Case:  X is a member of the rest of the list

member(X, [_Y|Xs]) :- member(X,Xs).


%%  members(Listy, Listz)
%% ----------------------------------------------------------
%%  Holds if Listy is a subset of Listz (i.e., if all the members of
%%  Listy are also members of Listz).

%%  Base Case:  Empty list is a subset of any list.

members([],_Ys).

%%  Recursive Case:  First list is non-empty

members([X|Xs], Ys) :- member(X,Ys), members(Xs,Ys).


%% ===========================================
%%  MAP COLORING EXAMPLE
%% ===========================================
%%  Given a Map and a list of Colors, assign colors to each of the
%%  regions in the map such that no two adjacent regions have the
%%  same color.
%% -------------------------------------------
%%  Taken from the book, "The Art of Prolog" by Sterling and Shapiro


%%  colors
%% ---------------------------------------------
%%  Essentially defines the list of available colors.

colors([red, yellow, blue, white]).


%%  A "map" is simply a list of "regions".
%%  Note that each region is represented by a *functional* term.
%%  The function "region" is not defined anywhere, it is used
%%  simply for pattern matching (i.e., unification).

%%  map
%% ---------------------------------------
%%  Used to associate a name (e.g., test) with a complicated data structure.
%%  Makes testing much easier.
%%  The following "facts" essentially define two maps named "test" and "tester".

map(test, [ region(a,A,[B,C,D]),
            region(b,B,[A,C,E]),
            region(c,C,[A,B,D,E,F]),
            region(d,D,[A,C,F]),
            region(e,E,[B,C,F]),
            region(f,F,[C,D,E]) ]).

map(tester, [ region(a,A,[B]),
              region(b,B,[A]) ]).


%%  colorRegion(region(Name,Color,Neighbors), Colors)
%% -------------------------------------------------------
%%  Holds if the indicated region can be safely 
%%  colored Color, while the colors of its neighbors are
%%  in the list Neighbors.  All colors are chosen from
%%  the list Colors.

%%  Note:  The following rule does not use the Name of the region;
%%         Thus, it is preceded by an underscore to avoid
%%         a warning from the compiler.

colorRegion( region(_Name,Color,Neighbors), Colors) :-
  %% Removing Color from the list, Colors, yields the RemainingColors
  select(Color,Colors,RemainingColors),
  %% The colors of the neighbors must be chosen from the remaining colors
  members(Neighbors,RemainingColors).


%%  colorMap(Map, Colors)
%% ------------------------------------------------------
%%  Holds if the colors assigned to the regions in the map,
%%  which must be drawn from the list of Colors, does not violate
%%  any adjacency constraints.

%%  Base Case:  Map contains no regions; makes it easy to color!

colorMap([],_Colors).

%%  Recursive Case:  Map contains at least one region.

colorMap( [Region|Regions], Colors ) :-
  %% color that region (in a way that satisfies adjacency constraints)
  colorRegion(Region,Colors),
  %% color the rest of the map
  colorMap(Regions,Colors).


%%  testColor(Name, Map)
%% ---------------------------------------------------------
%%  Holds if the Map associated with the name, Name, can be
%%  colored in using the available colors, without violating
%%  any adjacency constraints.

testColor(Name, Map) :-
  %% fetch the Map associated with the given Name
  map(Name, Map),
  %% fetch the list of available Colors
  colors(Colors),
  %% try to color the Map using those Colors
  colorMap(Map, Colors).

%% To test:  testColor(test, Map).
%%           testColor(tester, Map). 

%% ?- testColor(test,Map).
%% Map = [ region(a, red, [yellow, blue, yellow]), 
%%         region(b, yellow, [red, blue, red]), 
%%         region(c, blue, [red, yellow, yellow, red, white]), 
%%         region(d, yellow, [red, blue, white]), 
%%         region(e, red, [yellow, blue, white]), 
%%         region(f, white, [blue, yellow|...])] .
%%
%% NOTE:  If you hit the semi-colon, swipl will try to find additional answers,
%%        as illustrated below.
%%
%% ?- testColor(tester,Map).
%% Map = [region(a, red, [yellow]), region(b, yellow, [red])] ;
%% Map = [region(a, red, [blue]), region(b, blue, [red])] ;
%% Map = [region(a, red, [white]), region(b, white, [red])] .


%% =================================================
%%  The N-QUEENS PROBLEM
%% =================================================
%%  Place N queens on a N-by-N chessboard such that
%%  no two queens attack one another.
%% -------------------------------------------------
%%  Taken from the following web site:
%%   http://www.cse.scu.edu/~rdaniels/html/courses/Coen171/NQProlog.htm

%%  zboard
%% ---------------------------------------------------
%%  The following "fact" enables us to conveniently access
%%  a chessboard, represented as a list of Row/Col pairs.
%%  NOTE:  The slash is a function/constructor, just like
%%         "region" from the map coloring example.
%%         Thus, 1/C1 is a functional term with two arguments: 1 and C1.

zboard([1/C1, 2/C2, 3/C3, 4/C4, 5/C5, 6/C6, 7/C7, 8/C8]).     


%%  zqueens(Rows)
%% -------------------------------------------------
%%  NOTE:  Rows is a list of rows on a chessboard
%%         not necessarily the whole board. 
%% -------------------------------------------------
%%  zqueens(Rows) holds if Rows contain a queen in
%%    each row, and none attack each other.

%%  Base Case:  Placing 0 queens on a 0-by-0 board is easy!

zqueens([]). 

%%  Recursive Case:  Board contains at least one Row.
%% -----------------------------------------------------
%%    NOTICE that "pattern matching" (i.e., unification)
%%      can be done on terms like "Row/Col". 

zqueens([ Row/Col | Rest]) :- 
  %% First, place queens on the Rest of the Rows
  zqueens(Rest), 
  %% Then choose a colum, Col, for the current Row
  member(Col, [1,2,3,4,5,6,7,8]), 
  %% The chosen Col must be "safe" (i.e., the queen placed
  %% there must not attack any queens on the following Rows.
  zsafe( Row/Col, Rest).  
  %%  NOTE:  If zsafe fails, then fall back and try to
  %%         select another column, Col.  If no good value
  %%         can be found for Col, then fall back to
  %%         previous row


%%  zsafe(Row/Col, Rest)
%% -------------------------------------------------------
%%  Holds if placing a queen in Row/Col does not attack
%%  any of the queens on the Rest of the rows.

%%  Base Case:  No other queens to worry about

zsafe(_Row/_Col, []).  

%%  Recursive Case:  At least one other queen (at Row1/Col1)
%%                   that we should not be attacking!

zsafe(Row/Col, [Row1/Col1 | Rest]) :-  
  %% Base Case:  verify that the queens in Row/Col and Row1/Col1
  %% do not attack each other:
  %% -------------------------------------------
  %% Can't have two queens in the same column
  Col =\= Col1,               
  %% Can't have two queens on the same diagonal
  Col1 - Col =\= Row1 - Row,   % <--- up-right diagonal
  Col1 - Col =\= Row - Row1,   % <--- down-right diagonal

  %% Recursive Case:  verify that the queen in Row/Col does not attack
  %% any of the other queens.
  zsafe(Row/Col, Rest).   % no attack on next row, try the rest of board


%%  testQueens(Board)
%% -----------------------------------------------------
%%  Holds if queens can be placed on Board without attacking
%%  one another.  (testQueens facilitates testing.)

testQueens(Board) :- 
  %% Partially instantiate Board as a list of Row/Col pairs
  %%  where the Rows are instantiated, but not the columns.
  zboard(Board),
  %% Instantiate the Col variables while observing the 
  %% "no attacking" constraints.
  zqueens(Board).


%%  Sample results (demonstrating multiple solutions)
%% ----------------------------------------------------
%% ?- testQueens(Brd).
%% Brd = [1/4, 2/2, 3/7, 4/3, 5/6, 6/8, 7/5, 8/1] ;
%% Brd = [1/5, 2/2, 3/4, 4/7, 5/3, 6/8, 7/6, 8/1] ;
%% Brd = [1/3, 2/5, 3/2, 4/8, 5/6, 6/4, 7/7, 8/1] ;
%% Brd = [1/3, 2/6, 3/4, 4/2, 5/8, 6/5, 7/7, 8/1] .


%% ==============================================
%%  CONTEXT-FREE GRAMMAR EXAMPLE
%% ==============================================

%%  sentence
%% -------------------------------------------------------------------------
%%  A sentence can be constructed out of a noun phrase and a verb phrase.

sentence(S) :-
  nounPhrase(Np),
  verbPhrase(Vp),
  append(Np,Vp,S).

%%  nounPhrase
%% --------------------------------------------------------------------------

%%  One kind of noun phrase is a proper noun.

nounPhrase([N]) :- properNoun(N).

%%  Another kind of noun phrase is a determiner followed by a noun.

nounPhrase([D,N]) :- det(D), noun(N).

%%  verbPhrase
%% --------------------------------------------------------------------------

%%  One kind of verb phrase is an "intransitive" verb (e.g., "walks").

verbPhrase([V]) :- iVerb(V).

%%  Another kind of verb phrase is a "transitive" verb followed by a 
%%  direct object (which is a noun phrase).

verbPhrase([V|Resty]) :- tVerb(V), nounPhrase(Resty).

%%  A sample (tiny) lexicon
%% -------------------------------------------------------------------------

%%  The words "a" and "the" are determiners.

det(a).
det(the).

%%  The words "ball" and "window" are nouns.

noun(ball).
noun(window).

%%  The words "luke" and "barack" are proper nouns.

properNoun(luke).
properNoun(barack).

%%  "sleeps" is an intransitive verb; "throws" is transitive.

iVerb(sleeps).
tVerb(throws).


%%  Some tests:
%%
%% ?- sentence(S).
%% S = [luke, sleeps] ;
%% S = [luke, throws, luke] ;
%% S = [luke, throws, barack] ;
%% S = [luke, throws, a, ball] ;
%% S = [luke, throws, a, window] ;
%% S = [luke, throws, the, ball] ;
%% S = [luke, throws, the, window] ;
%% S = [barack, sleeps] ;
%% S = [barack, throws, luke] ;
%% S = [barack, throws, barack] .
%% 
%% ?- sentence([luke, throws, a, ball]).
%% true .
%% 
%% ?- sentence([luke, ball, throws]).
%% false.
%% 
%% ?- sentence([luke, throws, X, Y]).
%% X = a,
%% Y = ball ;
%% X = a,
%% Y = window ;
%% X = the,
%% Y = ball ;
%% X = the,
%% Y = window ;
%% false.