% Unary natural numbers z, s(z), s(s(z)), ...

nat(z).
nat(s(N)) :- nat(N).

even(z).
even(s(s(N))) :- even(N).

plus(z, N, N).
plus(s(M), N, s(P)) :- plus(M, N, P).

%% N1 * N2 = N3
times(z, _, z).
times(s(N1), N2, N3_2) :-
	times(N1, N2, N3),
	plus(N3, N2, N3_2).

%% ----------------------------------------------------------------------
%% Problem 1.1: Division

%% To use times for division in a well-moded fashion, it must have one of the
%% following modes:
%%
%% times(+N1,-N2,+N3)
%% The first clause violates this mode because the middle argument is
%% not determined by the first and third.
%%
%% times(-N1,+N2,+N3)
%% The second clause violates this mode: in the inductive call, we use
%% times with mode (-,+,-) because N3 is not yet determined.  However,
%% times can independently be given mode (-,+,-), so it is possible to
%% use times with this mode.
%% However, with mode (-,+,-) times does not terminate on all inputs
%% (the inductive call is on the same number!), enumerating
%% all N1 and N3 such that N1 * N2 = N3.  This is a problem for using
%% times with mode (-,+,+): when N2 does not exactly divide N3, search
%% for a divisor loops.
%%
%% This non-termination is spurious, as reversing the order of the subgoals
%% gives times mode (-,+,+) without the non-terminating search:

%% N1 * N2 = N3
%% -    +    +
%% B    Q  = A
%% i.e., A/Q
divExact(z, _, z).
divExact(s(N1), N2, N3_2) :-
	plus(N3, N2, N3_2),
	divExact(N1, N2, N3).

%% -------------------------------------------------------------------------------
%% Problem 2.1: Binary arithmetic

%% bits
bit(zz).
bit(oo).

%% add3Bits(b1,b2,b3,r,c): bits 1-3, then result and then carry
add3Bits(zz,zz,zz,zz,zz).
add3Bits(oo,zz,zz,oo,zz).
add3Bits(zz,oo,zz,oo,zz).
add3Bits(zz,zz,oo,oo,zz).
add3Bits(zz,oo,oo,zz,oo).
add3Bits(oo,zz,oo,zz,oo).
add3Bits(oo,oo,zz,zz,oo).
add3Bits(oo,oo,oo,oo,oo).


%% binary arithmetic

%% a binary number is represented as a list of bits,
%% with the head of the list being the LMB.
%% zero is represented as the empty list,
%% and there can be no trailing 0s

bitlist([]).
bitlist([H|T]) :- bit(H),bitlist(T).

endsWithOO([oo]).
endsWithOO([_|T]) :- endsWithOO(T).

binaryNumber([]).
binaryNumber(L) :- bitlist(L),endsWithOO(L).

bitToBinary(zz,[]).
bitToBinary(oo,[oo]).

unaryToBinary(z,[]).
unaryToBinary(N, [zz|B]) :-
	plus(NOver2, NOver2, N), %% N is even; slick but probably inefficient way to do division
	unaryToBinary(NOver2, B).
unaryToBinary(N, [oo|B]) :-
	plus(s(NOver2), NOver2, N), %% N is odd; slick but probably inefficient way to do division
	unaryToBinary(NOver2, B).

%% This is logically the same as above, but the subgoal order is reversed,
%% which is necessary for it to have the stated mode. 

binaryToUnary(z,[]).
binaryToUnary(N, [zz|B]) :-
	binaryToUnary(NOver2, B),
	plus(NOver2, NOver2, N). %% N is even; slick but probably inefficient way to do division
binaryToUnary(N, [oo|B]) :-
	binaryToUnary(NOver2, B),
	plus(s(NOver2), NOver2, N). %% N is odd; slick but probably inefficient way to do division
%% ----------------------------------------------------------------------
%% Problem 3: Merge sort

merge(L1, [], L1).
merge([H1 | L1], [H2 | L2], [H1 | L]) :-
	H1 =< H2,
	merge(L1, [H2 | L2], L).
merge([H1 | L1], [H2 | L2], [H2 | L]) :-
	H1 > H2,
	merge([H1 | L1], L2, L).

%% A very slow but kind of cute way to do partitioning:
%%    find two lists that append to the list in question,
%%    and whose lengths differ by no more than one.  

lengthsDifferByNoMoreThan1([], []).
lengthsDifferByNoMoreThan1([_], []).
lengthsDifferByNoMoreThan1([], [_]).
lengthsDifferByNoMoreThan1([_|Xs], [_|Ys]) :- lengthsDifferByNoMoreThan1(Xs,Ys).

partition(In, FirstHalf, SecondHalf) :-
	append(FirstHalf, SecondHalf, In),
	lengthsDifferByNoMoreThan1(FirstHalf, SecondHalf).
	
mergesort([], []).
mergesort([X], [X]).
mergesort(Un, Sorted) :-
	partition(Un, FirstHalf, SecondHalf),
	%% you could put green cut here to prevent trying lots of different partitions
	%% !, 
	mergesort(FirstHalf, FirstHalfSorted),
	mergesort(SecondHalf, SecondHalfSorted),
	merge(FirstHalfSorted, SecondHalfSorted, Sorted).


%% ----------------------------------------------------------------------
%% Problem 4: Dutch National Flag

%% One solution is (morally) to mergesort with the appropriate
%% comparator. I don't want to get into higher-order programming in
%% prolog, though

%% Since we know there are only 3 possible values, a bucket sort is easy

dnfHelp([], [], [], []).

dnfHelp([R|Rest], [R | Red], White, Blue) :-
	red(R),
	dnfHelp(Rest, Red, White, Blue).
dnfHelp([W|Rest], Red, [W | White], Blue) :-
	white(W),
	dnfHelp(Rest, Red, White, Blue).
dnfHelp([B|Rest], Red, White, [B | Blue]) :-
	blue(B),
	dnfHelp(Rest, Red, White, Blue).

dnf(In, Out) :-
	dnfHelp(In, Red, White, Blue),
	append(Red,White,RW),
	append(RW,Blue,Out).

%% seeds
red(ketchup).
red(blood).
red(steel).
white(paper).
white(president).
white(light).
blue(sky).
blue(smurf).
blue(outthecandles).