% 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).