% CPSC 312 2024 - Practice Questions for the final
% Solutions that relate to Prolog

% Question 1

%zip(L1,L2,R) that is true if R consists of a list of pairs, such that
% zip([e1,e2,...,ek],[f1,f2,..fn],[(e1,f1),(e2,f2),...,(er,fr)]) where r = min(k,n).

zip([],_,[]).
zip(L,[],[]) :- dif(L,[]).
zip([H1|T1],[H2|T2],[(H1,H2)|R]) :- zip(T1,T2,R).

%?- zip([1,2,3],[a,b,c,d],Z).


% notin(E,L) is true if E is not in list L
notin(_,[]).
notin(E,[H|R]) :-
    dif(E,H),
    notin(E,R).

% apply(L,S,R) is true if list L becomes R according to substitution S
% where a substitution is a list of sub(from,to) terms
apply([],_,[]).
apply([H|L],S,[HR|R]):-
    rep(H,S,HR),
    apply(L,S,R).

% rep(E,S,R) is true if E gets replaced by R according to substitution S
rep(H,[],H).
rep(H,[sub(H,R)|_],R).
rep(H,[sub(H1,_)|S],R) :-
    dif(H,H1),
    rep(H,S,R).

%?- apply([a,b,c,d,e],[sub(a,4), sub(c,3), sub(f,7)],R).
%R=[4,b,3,d,e]
%?- apply([a,b,c,d,e],[sub(a,b), sub(b,a), sub(e,a)],R).
%R=[b,a,c,d,a]

% appla(A,S,R) is true if arithmetic expression A becomes R according to substitution S
appla(A,S,R) :-
    atomic(A),
    rep(A,S,R).
appla((A+B),S,(AR+BR)) :-
    appla(A,S,AR),
    appla(B,S,BR).
appla((A*B),S,(AR*BR)) :-
    appla(A,S,AR),
    appla(B,S,BR).

%?- appla(a+b*c*d+e*c,[sub(a,f), sub(c,3), sub(f,7)],R).
%  Note: appla can be called apply, but then you need to put the clauses together, and it will work for lists mixed with arithmetic expressions.


%  deln(N,E,L,R)  is true when R is the result of removing N instances of E from L.
deln(0,_,[],[]).
deln(N,E,[E|L],R) :-
    N>0,
    N1 is N-1,
    deln(N1,E,L,R).
deln(N,E,[H|L],[H|R]) :-
    deln(N,E,L,R).
% ?- deln(2,a,[a,v,a,t,a,r],R).

% Here is another solution
%  deln_alt(N,E,L,R)  is true when R is the result of removing N instances of E from L.
deln_alt(0,_,R,R).
deln_alt(N,E,[E|L],R) :-
    N>0,
    N1 is N-1,
    deln_alt(N1,E,L,R).
deln_alt(N,E,[H|L],[H|R]) :-
    N>0,
    deln_alt(N,E,L,R).
% ?- deln_alt(2,a,[a,v,a,t,a,r],R).

enrl_cs_not_math(S) :- enrolled(S,C), dept(C,comp_sci), \+ enrol_3rd_year_math(S).
enrol_3rd_year_math(S) :- enrolled(S,C2), dept(C2,math), level(C2,3).

% can_enrol(S,C) is true if student S can enrol in course C
can_enrol(S,cpsc330) :- passed_one(S,[cpsc203,cpsc210,cpen221]).
can_enrol(S,cpsc330) :- passed(S,math210),passed_one(S,[cspsc107,cpsc110]).
%  passed_one(S,L) is true if student S has passed one course in list L.
passed_one(S,[C|_]) :- passed(S,C).
passed_one(S,[_|L]) :- passed_one(S,L).

% passed(S,C) is true if student S passed cource C
% You need to define some facts to test can_enrol

% Question 2
% To get Prolog to print the solution, try the following queries (but try it by hand first!)
% np([dog,ate,seven,grapes],R,X) = np([dog|L],L,fido).
% p(X,Y,X) = p(Z,Z,c).   
% p(X,Y,X) = p(a,b,c).
% bar(f(X),g(g(b))) = bar(W,g(Y)).
% foo(Z, [a,z|X],X) = foo([a,m|W],W,[i,n,g]). 
% dl([a,b|X],X) = dl(Z,Z).  

% Question 3
above(X,Y) :- on(X,Z), above(Z,Y).
above(X,Y) :- on(X,Y).
on(a,b).
on(b,c).
on(c,d).
on(e,d).
on(d,f).

/*
yes(X) :- above(X,d).   resolve with above(X1,Y1) :- on(X1,Z1), above(Z1,Y1).  substitution: {X/X1,Y1/d}
yes(X1) :- on(X1,Z1), above(Z1,d).   resolve with on(a,b).  substitution {X1/a,Z1/b}
yes(a) :- above(b,d).  resolve with above(X2,Y2) :- on(X2,Z2), above(Z2,Y2).  substitution: {X2/b,Y2/d}
yes(a) :- on(b,Z2), above(Z2,d). resolve with on(b,c).  substitution {X2/b,Z2/c}
yes(a) :- above(c,d). resolve with above(X3,Y3) :- on(X3,Y3).  substitution {X3/c,Y3/d}
yes(a) :- on(c,d). resolve with on(c,d),   substitution {}
yes(a) :- .

Answer: X=a.
*/

% Question 4
%  Triples, Semantic Web (there are lots of possible solutions).
prop(cpsc312, 'rdf:type', course).
prop(student_of_grade, 'rdfs:range', student).
prop(student_of_grade, 'rdfs:domain', grade).
prop(course_of_grade, 'rdfs:range', course).
prop(course_of_grade, 'rdfs:domain', grade).
prop(g123, 'rdf:type', grade).
prop(g123, student_of_grade, s12345).
prop(g123, course_of_grade, cpsc312).
prop(g123, year_of_grade, 2024).
prop(g123, item_of_grade, mid1).
prop(h123, mark_of_grade, 41).
prop(s12345, 'rdf:type', student).
prop(s12345, first_name, "Sam").
prop(s12345, last_name, "Family").
prop(s12345, year_of_birth, 1995).
prop(s12345, month_of_birth, 10).
prop(s12345, day_in_month_of_birth, 21).

% Question 5

myremoveduplicates([],[]).
myremoveduplicates([E1|R],S) :-
    member(E1,R),
    myremoveduplicates(R,S).
myremoveduplicates([E1|R],[E1|S]) :-
    notin(E1,R),
    myremoveduplicates(R,S).

myremoveduplicatesfirst(Lst,Res) :- remdupfirst(Lst, [], Res).
remdupfirst([],_ ,[]).
remdupfirst([H|T],Lst2,S) :-
    member(H,Lst2),
    remdupfirst(T,Lst2,S).
remdupfirst([H|T],Lst2,[H|S]) :-
    notin(H,Lst2),
    remdupfirst(T,[H|Lst2],S).

% Try:
%?- myremoveduplicates([1,2,3,4,3,4,5,2,5,7,1,2],A).
%?- myremoveduplicatesfirst([1,2,3,4,3,4,5,2,5,7,1,2],A).

shuffle([],[],[]).
shuffle([H|T],L,[H|R]) :- shuffle(T,L,R).
shuffle(T,[H|L],[H|R]) :- shuffle(T,L,R).
% Try:
%?- shuffle([1,2,3],[5,6,7],S).

% Question 6

% def(F,A,FA) function F on argument A returns FA
def(sq,X,X2) :- X2 is X*X.
def(plus,X,plus(X)).
def(plus(X),Y,Z) :- Z is X+Y.
def(gt,X,gt(X)).     % gt(X) is \Y -> X>Y
def(gt(X),Y,true) :- X>Y.
def(gt(X),Y,false) :- X =< Y.

% eval(E,V) is true if expression E evaluates to V
% this uses square brackets as parentheses, values separated by commas
eval(N,N) :- number(N).
eval([V],V).
eval([P,A|R],V) :-
    eval(A,AV),
    def(P,AV,R1),
    eval([R1|R],V).

% eval([sq,[plus,3,7]],V).


% mapWhile(F,P,[X1,X2,...,Xn]) = [f X1,f X2,...,f Xk]
% where k is the largest index such that P Xi is true for all i=<k
mapWhile(_,_,[],[]).
mapWhile(_,P,[H|_],[]) :- eval([P,H],false).
mapWhile(F,P,[H|T],[FH|R]) :-
    eval([P,H],true),
    eval([F,H],FH),
    mapWhile(F,P,T,R).

% mapWhile(plus(20),gt(10),[9,8,4,1,55,7,8,1,33],R).
% R = [29, 28, 24, 21] 

%%%%%%%%%%%% Question 7

wff(A,B) :- terminal(A,Z), binop(Z,Y), wff(Y,B).
wff(A,B) :- unop(A,Z), wff(Z,B).
wff(A,B) :- terminal(A,B).

binop([&|T],T).
binop([or|T],T).
unop([not|T],T).

terminal([Term|T],T) :- term(Term).

term(p).
term(q).
term(r).

% wff([p,&,not,q,or,r],V).
/*
yes(V) :- wff([p,&,not,q,or,r],V).
yes(V) :- terminal([p,&,not,q,or,r],Z1), binop(Z1,Y1), wff(Y1,V).
yes(V) :- term(p), binop([&,not,q,or,r],Y1), wff(Y1,V).
yes(V) :- binop([&,not,q,or,r],Y1), wff(Y1,V).
yes(V) :- wff([not,q,or,r],V).
yes(V) :- unop([not,q,or,r],Z2),wff(Z2,V).
yes(V) :- wff([q,or,r],V).
yes(V) :- terminal([q,or,r],Z3), binop(Z3,Y3), wff(Y3,V).
yes(V) :- term(q), binop([or,r],Y3), wff(Y3,V).
yes(V) :- binop([or,r],Y3), wff(Y3,V).
yes(V) :- wff([r],V).
yes(V) :- terminal([r],V).
yes([]) :- term(r).
yes([]).

Other answers:
V = [or, r] ;
V = [&, not, q, or, r].

*/

wff_r(A,B,R) :- terminal_r(A,Z,T), binop_r(Z,Y,T,BR,R), wff_r(Y,B,BR).
wff_r(A,B,R) :- unop_r(A,Z,BV,R), wff_r(Z,B,BV).
wff_r(A,B,R) :- terminal_r(A,B,R).

binop_r([&|T],T,X,Y,and(X,Y)).
binop_r([or|T],T,X,Y,or(X,Y)).
unop_r([not|T],T,TV,not(TV)).

terminal_r([Term|T],T,Term) :- term(Term).

%wff_r([p,&,q,or,r],E,T).

% Question 8

% (a) In Prolog one can just use the constant empty and the function Node(,,,)

% (b)
% Haskell: Node(3,"a",Node(1,"b",Empty,Empty),Empty)
% Prolog:  node(3,"a",node(1,"b",empty,empty),empty)

% (c)
lefttree(node(_,_,LT,_),LT).

% (d) Prolog just fails if applied to an empty tree

insert(K,V,empty,node(K,V,empty,empty)).
insert(K,V,node(K,_,LT,RT),node(K,V,LT,RT)).
insert(K,V,node(K1,V1,LT,RT),node(K1,V1,LT1,RT)) :-
    K < K1,
    insert(K,V,LT,LT1).
insert(K,V,node(K1,V1,LT,RT),node(K1,V1,LT,RT1)) :-
    K1 < K,
    insert(K,V,RT,RT1).

tolista(Lst,Res) :- tolist2(Lst,[],Res).
tolist2(empty,Acc,Acc).
tolist2(node(Key,Val,LT,RT),Acc, Res) :-
    tolist2(RT, Acc, Acc1),
    tolist2(LT,[(Key,Val)|Acc1],Res).

% Try:
%?- insert(3,"a",empty,T1),insert(1,"b",T1,T2), tolista(T2,L).
