% subpred.pl Generate all subject-predicate combinations for two statements 

% Written by Richard Power
% Copyright (c) 2011 by Open University

%==================================================

:- module(subpred, [run/0]).

:- use_module(library(lists)).
:- use_module(library(ordsets)).
:- use_module(library(clpfd)).

% Module code

% We have two sentences 1 and 2, each composed of a subject and
% predicate, interpreted as set-denoting expressions. This means
% we have four sets S1, P1, S2, P2, with the constraints that
% S1 is narrower or equal to P1, and S2 is narrower or equal to
% P2. Can we enumerate every possible set relationship between
% S1-S2, P1-P2, S2-P1 and S1-P2? The relationships are narrower,
% wider, equal, distinct, or partially overlapping. This can be set
% up as a CSP.
%
% 1 A is narrower than B
% 2 A is wider than B
% 3 A is equal to B
% 4 A is distinct from B
% 5 A partially overlaps B
%
% A statement with S narrower than P (1) is like subClassOf in OWL,
% S equal to P (3) is like equivalentClasses, and S distinct from P (4)
% is like disjointClasses. To constrain the statements considered,
% edit the lines commented below. At present they are set to allow
% the three relations just mentioned (1, 3, 4).

run :-
  findall(Solution, generateSolution(Solution), Solutions),
  length(Solutions, N),
  filter(Solutions, Filtered),
  transcode(Solutions, Transcoded),
  reorder(Transcoded, Ordered),
  reorder(Filtered, Coherent),
  length(Filtered, F),
  write('Coherent solutions = '), write(F/N), nl,
  saveList('solutions.txt', Ordered),
  saveList('coherent.txt', Coherent).

generateSolution(Solution) :-
  initialise(Solution, Vars),
  constrain(Vars),
  labeling([], Vars).

initialise([rel(s1-p1, S1P1),
            rel(s1-s2, S1S2),
            rel(s1-p2, S1P2),
            rel(p1-s2, P1S2),
            rel(p1-p2, P1P2),
            rel(s2-p2, S2P2)], [S1P1,S1S2,S1P2,P1S2,P1P2,S2P2]) :-
  S1P1 in 1..4, S1P1 #\= 2, % Edit this line to constraint statement types
  S1S2 in 1..5,
  S1P2 in 1..5,
  P1S2 in 1..5,
  P1P2 in 1..5,
  S2P2 in 1..4, S2P2 #\= 2. % Edit this line to constraint statement types

constrain([S1P1,S1S2,S1P2,P1S2,P1P2,S2P2]) :-
  triangle(S1P1, P1S2, S1S2),
  triangle(S1P1, P1P2, S1P2),
  triangle(S1S2, S2P2, S1P2),
  triangle(P1S2, S2P2, P1P2).

triangle(AB, BC, AC) :-
% AB BC => AC
  (AB #= 1) #/\ (BC #= 1) #=> (AC #= 1),
  (AB #= 1) #/\ (BC #= 3) #=> (AC #= 1),
  (AB #= 1) #/\ (BC #= 4) #=> (AC #= 4),
  (AB #= 2) #/\ (BC #= 1) #=> (AC #\= 4),
  (AB #= 2) #/\ (BC #= 2) #=> (AC #= 2),
  (AB #= 2) #/\ (BC #= 3) #=> (AC #= 2),
  (AB #= 3) #/\ (BC #= 1) #=> (AC #= 1),
  (AB #= 3) #/\ (BC #= 2) #=> (AC #= 2),
  (AB #= 3) #/\ (BC #= 3) #=> (AC #= 3),
  (AB #= 3) #/\ (BC #= 4) #=> (AC #= 4),
  (AB #= 3) #/\ (BC #= 5) #=> (AC #= 5),
  (AB #= 4) #/\ (BC #= 1) #=> (AC #\= 2) #/\ (AC #\= 3),
  (AB #= 4) #/\ (BC #= 2) #=> (AC #= 4),
  (AB #= 4) #/\ (BC #= 3) #=> (AC #= 4),
  (AB #= 4) #/\ (BC #= 5) #=> (AC #\= 2) #/\ (AC #\= 3),
  (AB #= 5) #/\ (BC #= 1) #=> (AC #= 1) #\/ (AC #= 5),
  (AB #= 5) #/\ (BC #= 2) #=> (AC #= 4) #\/ (AC #= 5),
  (AB #= 5) #/\ (BC #= 3) #=> (AC #= 5),
  (AB #= 5) #/\ (BC #= 4) #=> (AC #\= 1) #/\ (AC #\= 3),

% AB AC => BC
  (AB #= 1) #/\ (AC #= 1) #=> (BC #\= 4),
  (AB #= 1) #/\ (AC #= 2) #=> (BC #= 2),
  (AB #= 1) #/\ (AC #= 3) #=> (BC #= 2),
  (AB #= 1) #/\ (AC #= 4) #=> (BC #\= 1) #/\ (BC #\= 3),
  (AB #= 1) #/\ (AC #= 5) #=> (BC #= 2) #\/ (BC #= 5),
  (AB #= 2) #/\ (AC #= 1) #=> (BC #= 1),
  (AB #= 2) #/\ (AC #= 3) #=> (BC #= 1),
  (AB #= 2) #/\ (AC #= 4) #=> (BC #= 4),
  (AB #= 2) #/\ (AC #= 5) #=> (BC #\= 2) #/\ (BC #\= 3),
  (AB #= 3) #/\ (AC #= 1) #=> (BC #= 1),
  (AB #= 3) #/\ (AC #= 2) #=> (BC #= 2),
  (AB #= 3) #/\ (AC #= 3) #=> (BC #= 3),
  (AB #= 3) #/\ (AC #= 4) #=> (BC #= 4),
  (AB #= 3) #/\ (AC #= 5) #=> (BC #= 5),
  (AB #= 4) #/\ (AC #= 1) #=> (BC #\= 2) #/\ (BC #\= 3),
  (AB #= 4) #/\ (AC #= 2) #=> (BC #= 4),
  (AB #= 4) #/\ (AC #= 3) #=> (BC #= 4),
  (AB #= 4) #/\ (AC #= 5) #=> (BC #\= 2) #/\ (BC #\= 3),
  (AB #= 5) #/\ (AC #= 1) #=> (BC #= 1) #\/ (BC #= 5),
  (AB #= 5) #/\ (AC #= 2) #=> (BC #\= 1) #/\ (BC #\= 3),
  (AB #= 5) #/\ (AC #= 3) #=> (BC #= 5),
  (AB #= 5) #/\ (AC #= 4) #=> (BC #\= 1) #/\ (BC #\= 3),

% BC AC => AB
  (BC #= 1) #/\ (AC #= 2) #=> (AB #= 2),
  (BC #= 1) #/\ (AC #= 3) #=> (AB #= 2),
  (BC #= 1) #/\ (AC #= 4) #=> (AB #= 4),
  (BC #= 1) #/\ (AC #= 5) #=> (AB #\= 1) #/\ (AB #\= 3),
  (BC #= 2) #/\ (AC #= 1) #=> (AB #= 1),
  (BC #= 2) #/\ (AC #= 2) #=> (AB #\= 4),
  (BC #= 2) #/\ (AC #= 3) #=> (AB #= 1),
  (BC #= 2) #/\ (AC #= 4) #=> (AB #\= 2) #/\ (AB #\= 3),
  (BC #= 2) #/\ (AC #= 5) #=> (AB #= 1) #\/ (AB #= 5),
  (BC #= 3) #/\ (AC #= 1) #=> (AB #= 1),
  (BC #= 3) #/\ (AC #= 2) #=> (AB #= 2),
  (BC #= 3) #/\ (AC #= 3) #=> (AB #= 3),
  (BC #= 3) #/\ (AC #= 4) #=> (AB #= 4),
  (BC #= 3) #/\ (AC #= 5) #=> (AB #= 5),
  (BC #= 4) #/\ (AC #= 1) #=> (AB #= 4),
  (BC #= 4) #/\ (AC #= 2) #=> (AB #\= 1) #/\ (AB #\= 3),
  (BC #= 4) #/\ (AC #= 3) #=> (AB #= 4),
  (BC #= 4) #/\ (AC #= 5) #=> (AB #\= 1) #/\ (AB #\= 3),
  (BC #= 5) #/\ (AC #= 1) #=> (AB #\= 2) #/\ (AB #\= 3),
  (BC #= 5) #/\ (AC #= 2) #=> (AB #= 2) #\/ (AB #= 5),
  (BC #= 5) #/\ (AC #= 3) #=> (AB #= 5),
  (BC #= 5) #/\ (AC #= 4) #=> (AB #\= 2) #/\ (AB #\= 3).

% Filter out solutions for which the statements have no term in common

filter([], []).
filter([S|Ss], [NewS|NewSs]) :- relevant(S, NewS), filter(Ss, NewSs), !.
filter([_|Ss], NewSs) :- filter(Ss, NewSs).

relevant([rel(s1-p1,A),rel(s1-s2,B),rel(s1-p2,C),rel(p1-s2,D),rel(p1-p2,E),rel(s2-p2,F)], A-B-C-D-E-F) :-
  (memberchk(3, [B,C,D,E]); [B,C,D,E]=[4,4,4,4]).

transcode([], []).
transcode([S|Ss], [NewS|NewSs]) :- tcode(S, NewS), transcode(Ss, NewSs), !.

tcode([rel(s1-p1,A),rel(s1-s2,B),rel(s1-p2,C),rel(p1-s2,D),rel(p1-p2,E),rel(s2-p2,F)], A-B-C-D-E-F).

% Order by S1P1 and S2P2

reorder(Solutions, Numbered) :-
  recode(Solutions, Recode),
  sort(Recode, Sorted),
  replace(Sorted, Ordered),
  renumber(1, Ordered, Numbered).

recode([], []).
recode([S|Ss], [NewS|NewSs]) :- S=A-B-C-D-E-F, NewS=A-F-B-C-D-E, recode(Ss, NewSs).

replace([], []).
replace([S|Ss], [NewS|NewSs]) :- S=A-F-B-C-D-E, NewS=A-B-C-D-E-F, replace(Ss, NewSs).

renumber(_, [], []).
renumber(N, [X|Xs], [(N=X)|NewXs]) :- M is N+1, renumber(M, Xs, NewXs).

% Save and load lists

saveList(FileName, List) :-
  open(FileName, write, Stream),
  writeTerms(Stream, List),
  close(Stream),
  write(FileName), write(' written'), nl.

loadList(FileName, List) :-
  open(FileName, read, Stream),
  readTerms(Stream, List),
  close(Stream).

writeTerms(_Stream, []).
writeTerms(Stream, [T|Ts]) :- writeTerm(Stream, T), writeTerms(Stream, Ts).

writeTerm(Stream, Term) :-
  writeT(Stream, Term),
  write(Stream, '.'),
  nl(Stream).

writeT(Stream, T) :- atom(T), write(Stream, T), !.
writeT(Stream, T) :- writeq(Stream, T).

readTerms(Stream, []) :- at_end_of_stream(Stream), !.

readTerms(Stream, [T|Ts]) :-
  read(Stream, T),
  readTerms(Stream, Ts).




