Prolog programs:
A Turing machine:
====================================================================
%----------------------------------------------------------------------------
% xiaoyuan suo
%
%tape (left_part, current_position, right_part )
%
%tm(even, tape([],1,[0,1,1,0]), T1).
% tm(1, tape([],a,[a,b,a,a,a,b,b,b]), T1).
% tm(1, tape([],a,[a,b,b,a]), T1).
%
%----------------------------------------------------------------------------
tm(h,T,_) :-
atom_chars(T1,T),
write('Final Tape Contents Are'),nl,
print(T1),nl.
tm(Q,T,Pos):-
nth1(Pos,T,C),
delta(Q,Q1,C,S,D),
replace(T,S,T1,Pos),
move(T1,D,Pos,NewPos),
tm(Q1,T1,NewPos).
run_tm(Input):-
start_state(P),
atom_chars(Input,Input1),
append([#],Input1,Input2),
append(Input2,[#],Input3),
tm(P,Input3,2).
%----------------------------------------------------------------------------
% delta(current state, new_state, input_symbol,output_symbol, head_movement)
% replace(tape(L, C, [X|R]), r, tape([C|L],X,R)).
%----------------------------------------------------------------------------
replace([_|T],W,[W|T],1).
replace([X|T],S,[X|L2],Pos):-
Pos>1,
NewPos is Pos-1,
replace(T,S,L2,NewPos).
%----------------------------------------------------------------------------
% move (tape_before,direction,Current position, new Position).
%----------------------------------------------------------------------------
move(_,l,Pos,NewPos):-
Pos>1,
NewPos is Pos-1.
move(T,r,Pos,NewPos):-length(T,P),
Pos<P,
NewPos is Pos+1.
=================================================================================
Sodoku Solver
=================================================================================
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%replace test3 with the input
%%
%% *this is the final version*
%%
%% i started with the sample program from the board
%%
%% all you have to do, is compile the program as
%% usual, ['hw3.pl']. then type in: "test1.pl"
%% "test2.pl." etc. please feel free to replace
%% test1--test3 with your input~
%%
%% by xiaoyuan suo
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library('clp/bounds')).
%-------------------------------------------------------------
%%possible input, replace this part with the desired input
%% test1 is a hard sudoku
%% test2 is an easy one
%% test3 is an extremely hard sudoku
%-------------------------------------------------------------
test1 :-
L=
[
[_,4,3,_,8,_,2,5,_],
[6,_,_,_,_,_,_,_,_],
[_,_,_,_,_,1,_,9,4],
[9,_,_,_,_,4,_,7,_],
[_,_,_,6,_,8,_,_,_],
[_,1,_,2,_,_,_,_,3],
[8,2,_,5,_,_,_,_,_],
[_,_,_,_,_,_,_,_,5],
[_,3,4,_,9,_,7,1,_]
],
sudoku(L),
displaySolution(L).
test2 :-
L=[
[_,_,_,1,5,_,_,7,_],
[1,_,6,_,_,_,8,2,_],
[3,_,_,8,6,_,_,4,_],
[9,_,_,4,_,_,5,6,7],
[_,_,4,7,_,8,3,_,_],
[7,3,2,_,_,6,_,_,4],
[_,4,_,_,8,1,_,_,9],
[_,1,7,_,_,_,2,_,8],
[_,5,_,_,3,7,_,_,_]
],
sudoku(L),
displaySolution(L).
test3 :-
L=
[[_,_,3,_,2,5,_,_,_],
[_,_,_,_,_,_,5,3,8],
[7,5,1,_,_,_,_,_,2],
[_,_,_,_,8,_,6,5,1],
[_,_,_,3,4,7,_,_,_],
[8,9,2,_,5,_,_,_,_],
[9,_,_,_,_,_,1,7,4],
[6,4,5,_,_,_,_,_,_],
[_,_,_,8,9,_,2,_,_]
],
sudoku(L),
displaySolution(L).
%---------------------------------------------------------------
sudoku(L) :- flatten(L,A),
A in 1..9,
%-------------------------------------------------------------
%first of all, all rows should be different
%-------------------------------------------------------------
[R1,R2,R3,R4,R5,R6,R7,R8,R9] = L,
all_different(R1), all_different(R2), all_different(R3),
all_different(R4), all_different(R5), all_different(R6),
all_different(R7), all_different(R8), all_different(R9),
%-------------------------------------------------------------
%all columns should be different too
%-------------------------------------------------------------
transpose(L,CL),
[C1,C2,C3,C4,C5,C6,C7,C8,C9] = CL,
all_different(C1), all_different(C2), all_different(C3),
all_different(C4), all_different(C5), all_different(C6),
all_different(C7), all_different(C8), all_different(C9),
%-------------------------------------------------------------
%then, all 3X3 squares inside the big matrix should be different
%variables should be different
%and the solution should be different also
%-------------------------------------------------------------
[X11,X12,X13,X14,X15,X16,X17,X18,X19] = R1,
[X21,X22,X23,X24,X25,X26,X27,X28,X29] = R2,
[X31,X32,X33,X34,X35,X36,X37,X38,X39] = R3,
[X41,X42,X43,X44,X45,X46,X47,X48,X49] = R4,
[X51,X52,X53,X54,X55,X56,X57,X58,X59] = R5,
[X61,X62,X63,X64,X65,X66,X67,X68,X69] = R6,
[X71,X72,X73,X74,X75,X76,X77,X78,X79] = R7,
[X81,X82,X83,X84,X85,X86,X87,X88,X89] = R8,
[X91,X92,X93,X94,X95,X96,X97,X98,X99] = R9,
all_different([X11,X12,X13,X21,X22,X23,X31,X32,X33]),
all_different([X41,X42,X43,X51,X52,X53,X61,X62,X63]),
all_different([X71,X72,X73,X81,X82,X83,X91,X92,X93]),
all_different([X14,X15,X16,X24,X25,X26,X34,X35,X36]),
all_different([X44,X45,X46,X54,X55,X56,X64,X65,X66]),
all_different([X74,X75,X76,X84,X85,X86,X94,X95,X96]),
all_different([X17,X18,X19,X27,X28,X29,X37,X38,X39]),
all_different([X47,X48,X49,X57,X58,X59,X67,X68,X69]),
all_different([X77,X78,X79,X87,X88,X89,X97,X98,X99]),
label([X11,X12,X13,X21,X22,X23,X31,X32,X33]),
label([X41,X42,X43,X51,X52,X53,X61,X62,X63]),
label([X71,X72,X73,X81,X82,X83,X91,X92,X93]),
label([X14,X15,X16,X24,X25,X26,X34,X35,X36]),
label([X44,X45,X46,X54,X55,X56,X64,X65,X66]),
label([X74,X75,X76,X84,X85,X86,X94,X95,X96]),
label([X17,X18,X19,X27,X28,X29,X37,X38,X39]),
label([X47,X48,X49,X57,X58,X59,X67,X68,X69]),
label([X77,X78,X79,X87,X88,X89,X97,X98,X99]).
%---------------------------------------------------------------
% the part below:
% borrowed from http://bach.istc.kobe-u.ac.jp/llp/crypt.llp
% transpose(Words, Columns)
% For example, when Words = [[S,E,N,D],[M,O,R,E],[M,O,N,E,Y]],
% Columns = [[D,E,Y],
% [N,R,E],
% [E,O,N],
% [S,M,O],
% [M]]
%---------------------------------------------------------------
transpose([Word], Cs) :- !,
reverse(Word, R),
list2columns(R, Cs).
transpose([Word|Words], Cs) :- !,
transpose(Words, Cs0),
reverse(Word, R),
put_columns(R, Cs0, Cs).
list2columns([], []).
list2columns([X|Xs], [[X]|Zs]) :- list2columns(Xs, Zs).
put_columns([], Cs, Cs).
put_columns([X|Xs], [C|Cs0], [[X|C]|Cs]) :- put_columns(Xs, Cs0, Cs).
%---------------------------------------------------------------
%finally, have the solution being displayed
%---------------------------------------------------------------
displaySolution([]).
displaySolution([H|T]) :- write(H),nl, displaySolution(T).
=================================================================================
A database + some selection rules
=================================================================================
parts(10506,'Land Before Time I',200,19.99,20).
parts(10507,'Land Before Time II',156,19.99,20).
parts(10508,'Land Before Time III',190,19.99,20).
parts(10509,'Land Before Time IV',60,19.99,20).
parts(10601,'Sleeping Beauty',300,24.99,20).
parts(10701,'When Harry Met Sally',200,19.99,30).
parts(10800,'Dirty Harry',140,14.99,30).
parts(10900,'Dr. Zhivago',100,24.99,30).
parts(11000,'Suo_more_50',100,51.99,30).
employees(1000,'Jones',67226,'12-DEC-95').
employees(1001,'Smith',60606,'01-JAN-92').
employees(1002,'Brown',50302,'01-SEP-94').
customers(1111,'Charles','123 Main St.',67226,'316-636-5555').
customers(2222,'Bertram','237 Ash Avenue',67226,'316-689-5555').
customers(3333,'Barbara','111 Inwood St.',60606,'316-111-1234').
customers(4444,'Xiaoyuan','111 Outwood St.',61111,'316-111-1234').
customers(5555,'Suo_noOrder','222 Outwood St.',66002,'316-111-1234').
customers(6666,'Suo_all20','333 wood St.',54444,'316-111-1234').
orders(1020,1111,1000,'10-DEC-94','12-DEC-94').
orders(1021,1111,1000,'12-JAN-95','15-JAN-95').
orders(1022,2222,1001,'13-FEB-95','20-FEB-95').
orders(1023,3333,1000,'20-JUN-97','22-JUN-97').
orders(1024,4444,1000,'31-JAN-07','31-JAN-07').
orders(1025,6666,1002,'14-FEB-95','20-FEB-95').
orders(1026,6666,1001,'14-FEB-95','20-FEB-95').
zipcodes(67226,'Wichita').
zipcodes(60606,'Fort Dodge').
zipcodes(50302,'Kansas City').
zipcodes(54444,'Columbia').
zipcodes(66002,'Liberal').
zipcodes(61111,'Fort Hays').
odetails(1020,10506,1).
odetails(1020,10507,1).
odetails(1020,10508,2).
odetails(1020,10509,3).
odetails(1021,10601,4).
odetails(1022,10601,1).
odetails(1022,10701,1).
odetails(1023,10800,1).
odetails(1023,10900,1).
odetails(1024,11000,1).
odetails(1025,10506,1).
odetails(1025,10507,1).
odetails(1025,10508,1).
odetails(1025,10509,1).
odetails(1025,10701,1).
odetails(1026,10800,1).
q1(N) :- parts(_,N,_,P,_),P < 20.
answer1(L) :- setof([N],q1(N),L).
q2(N,C) :-
employees(E,N,Z,_),zipcodes(Z,C),orders(O,_,E,_,_),odetails(O,A,_),parts(A,_,_,P,_),P>50.
answer2(L) :- setof([N,Z],q2(N,Z),L).
q3(C,S) :- customers(C,_,_,Z,_),customers(S,_,_,Z,_),S \== C.
answer3(L) :- setof([C,S],q3(C,S),L).
temp1(N) :-
customers(C,N,_,_,_),orders(_,C,E,_,_),employees(E,_,Z,_),zipcodes(Z,T),T \==
'Wichita'.
q4(N) :-
customers(C,N,_,_,_),orders(_,C,E,_,_),employees(E,_,Z,_),zipcodes(Z,T),T='Wichita',not(temp1(N)).
answer4(L) :- setof([N],q4(N),L).
temp5(C,P) :- orders(O,C,_,_,_),odetails(O,P,_).
temp51(C,N) :- customers(C,N,_,_,_),parts(P,_,_,A,_),A<20,not(temp5(C,P)).
q5(N) :- customers(C,N,_,_,_), not(temp51(C,N)).
answer5(L) :- setof([N],q5(N),L).
temp6(N) :- customers(C,N,_,_,_),orders(O,C,_,_,_),odetails(O,_,Q),Q>0.
q6(N) :- customers(_,N,_,_,_),not(temp6(N)).
answer6(L) :- setof([N],q6(N),L).
q7(N) :- orders(O,C,_,_,_),orders(O1,C,_,_,_),O\==O1,customers(C,N,_,_,_),not(temp7(C)).
temp7(C) :-
orders(O2,C,_,_,_),orders(O3,C,_,_,_),orders(O4,C,_,_,_),O3\==O2,O3\==O4,O4\==O2.
answer7(L) :- setof([C],q7(C),L).
output([]) :- !.
output([X|L]) :- write(X), nl, output(L).
go :- tell(f),
answer1(L1),write('Answer to Q1'), nl,output(L1), nl,
answer2(L2),write('Answer to Q2'), nl,output(L2), nl,
answer3(L3),write('Answer to Q3'), nl,output(L3), nl,
answer4(L4),write('Answer to Q4'), nl,output(L4), nl,
answer5(L5),write('Answer to Q5'), nl,output(L5), nl,
answer6(L6),write('Answer to Q6'), nl,output(L6), nl,
answer7(L7),write('Answer to Q7'), nl,output(L7), nl,
told.