/* * CS 60, Fall 2010, Assignment 11 Solutions * Author: Robert Keller * * Logic Programming * * Due: Wed. December 8 by 11:59 PM * * Note: This is a skeletal Prolog file, a11.pro, which you can complete * with your own solutions. * * Load this file from the command-line, using e.g. * * swipl -f a11.pro * * assuming you are using SWI-Prolog. * * This assignment has four distinct parts, all of which can be expected * to use backtracking in some form: * * Part 1: Movies Database * Part 2: "42" puzzle. * Part 3: Sudograph solver * Part 4: Snack logic problem */ /***************************************************************************** * Part 1: Movies Database * * First download the file movies.pro from the course website and put it * in your working directory. */ /* * The following will load movies.pro into Prolog from your working directory. */ :- ensure_loaded('movies.pro'). tbd :- nl, write('Answer to be Provided'), nl, fail. % ans0 is solved for you % ans0 is true for the director of ['American Beauty', 1999]? ans0(Director) :- movie(['American Beauty', 1999], Director, _). % ans1 is true for any movie [Title, Year] in which Harrison Ford played a role. ans1(Movie) :- plays('Harrison Ford', _, Movie). % ans2 is true for any movie [Title, Year] having comedy as a descriptor. ans2(Movie) :- movie(Movie, _, Descriptors), member(comedy, Descriptors). % ans3 is true for the title of two movies with the same title but produced in different years. ans3(Title) :- movie([Title, Year1], _, _), movie([Title, Year2], _, _), Year1 \== Year2. % Utility actressOrActor(Person, Birthplace, Year) :- actress(Person, Birthplace, Year). actressOrActor(Person, Birthplace, Year) :- actor(Person, Birthplace, Year). % ans4 is true for an actress or actor born in New Jersey ans4(Person) :- actressOrActor(Person, [_, 'New Jersey'], _). % ans5 is true for an actress or actor born before 1950. ans5(Person) :- actressOrActor(Person, _, Year), Year < 1950. % ans6 is true for an actress or actor born in New Jersey before 1950. ans6(Person) :- ans4(Person), ans5(Person). % ans7 is true for a pair of an actor and actress who played together in the same movie. ans7(Actor, Actress) :- actor(Actor, _, _), plays(Actor, _, Movie), plays(Actress, _, Movie), actress(Actress, _, _). % ans8 is true for a pair of an actor and actress who played together in more than one movie. ans8(Actor, Actress) :- actor(Actor, _, _), plays(Actor, _, Movie1), plays(Actress, _, Movie1), actress(Actress, _, _), plays(Actor, _, Movie2), plays(Actress, _, Movie2), Movie1 \== Movie2. % ans9 is true for an actor or actress who both directed and played in the same movie. ans9(Actor) :- plays(Actor, _, Movie), movie(Movie, Actor, _). % ans10 lists actors and actresses together in order of increasing birth year, giving the year first. ans10(List) :- setof([Year, Person], City^(actress(Person, City, Year) ; actor(Person, City, Year)), List). % ans11 is true for the youngest actress or actor (give multiple results if there is a tie). ans11(Person) :- ans10(List), last(List, [Year, _]), (actor(Person, _, Year) ; actress(Person, _, Year)). % ans12(Degree, Person1, Person2) is true if Person1 is within Degree degrees of Person2. % within degree 1 means that Person1 and Person2 acted in the same movie. % within degree N > 1 means either Person1 is within degree N-1 of Person2, or % Person1 acted in a movie with some Person3, and Person2 is within degree N-1 of Person3. % % Degree is assumed to be instantiated. It is preferrable that each instance of Person2 be % given only once for an instance of Person1, and vice-versa. sameMovie(Person1, Person2) :- plays(Person1, _, Movie), plays(Person2, _, Movie). ans12(N, Person1, Person2) :- setof(Person, ans12helper(N, Person1, Person, [Person1]), Set), member(Person2, Set). ans12helper(1, Person1, Person2, Seen) :- sameMovie(Person1, Person2), \+member(Person2, Seen). ans12helper(N, Person1, Person2, Seen) :- N > 0, N1 is N-1, ans12helper(N1, Person1, Person2, Seen), \+member(Person2, Seen). ans12helper(N, Person1, Person2, Seen) :- N > 0, N1 is N-1, sameMovie(Person1, Person3), \+member(Person3, Seen), ans12helper(N1, Person3, Person2, [Person3 | Seen]). % ans13(N) means that N is the number of actors and actresses not within 6 degress of Kevin Bacon. ans13helper(Person) :- actressOrActor(Person, _, _), \+ans12(6, 'Kevin Bacon', Person). ans13(N) :- setof(Person, ans13helper(Person), Set), length(Set, N). /***************************************************************************** * Part 2: Construct a solver for the generalized "42" (formerly "24") puzzle. * * In the original game, players view a card with four numbers on it and * try to make an arithmetic expression using the operators +, -, *, / * so that the result is 24. * * Each number must be used exactly once. * Each operator can be used any number of times. * * In our generalization of the game, the fixed number 24 is replaced * with an arbitrary positive value, called the target, * the set of operators is specified in a list, and * the list of numbers can have any length, not just 4. (By definition, * no result can be made if the list is empty.) * * Define a 4-ary predicate solve such that * solve42(Ops, Values, Result, Exp) * will solve for an expression using operators Ops on the set Values * to give the value Result. For example, alluding to the original game * a dialog with Prolog would be: * * | ?- solve42([+, *, -], [2, 3, 4, 5], 24, Exp). * * Exp = [*, [+, [-, 3, 2], 5], 4] * * meaning that the expression evaluates to the target 24. * * The test harness will cause your solve42 to generate all solutions, * and it will compare the solutions to the answer key as a set. * * Assume that the set of operators will always be a subset of * [+, *, -]. * *****************************************************************************/ /* * Solve by getting a tree, and evaluating it. If Result is bound, this * will succeed only when the value of the tree is the desired value. */ solve42(Operators, Numbers, Target, Tree) :- makeTree(Operators, Numbers, Tree), eval(Tree, Target). /* * Evaluate a tree to get a number. */ /* Case of a leaf node */ eval(Number, Number) :- number(Number). /* Non-leaf cases */ eval([+, L, R], Number) :- eval(L, LV), eval(R, RV), Number is LV + RV. eval([-, L, R], Number) :- eval(L, LV), eval(R, RV), Number is LV - RV. eval([*, L, R], Number) :- eval(L, LV), eval(R, RV), Number is LV * RV. /* * Make a tree with a list of one value */ makeTree(_Ops, [Value], Value). /* * Make a tree for a list of more than one value. Split the values into two * make trees for each part recursively, then recombine into a tree. */ makeTree(Ops, Values, [Op, LeftTree, RightTree]) :- split(Values, LeftValues, RightValues), makeTree(Ops, LeftValues, LeftTree), makeTree(Ops, RightValues, RightTree), member(Op, Ops). /* * member(A, X, R) is true iff A is a member of X and R is the residue * after removing A from X */ member(A, [A | X], X). member(A, [B | X], [B | Y]) :- member(A, X, Y). /* * split(X, Y, Z) splits a list of at least two elements into two lists * of at least one element each. */ split(X, Y, Z) :- split1(X, Y, Z). split(X, Y, Z) :- split1(X, Z, Y). /* * Above, split calls split1 using the results in both orders. */ /* * Split a list of two elements. */ split1([A, B], [A], [B]). /* * Split a list of more than two elements, by removing a member of the * original list, splitting recursively, then adding the removed element * back onto the left list. * */ split1(X, [A | Y], Z) :- member(A, X, U), split(U, Y, Z). /***************************************************************************** * Part 3: Construct a Sudograph solver. * * Sudograph is a generalization of the popular sudoku puzzles. * * A single puzzle specifies: * an id number for the puzzle case, * a list of nodes, represented by logical variables, * a list of constraints, represented as lists of those same local variables, * a list of colors, which are atomic (atoms or numbers). * * The objective is to find a solution of the puzzle, which is defined to be * an assignment of a color to each node, such that no two nodes in any * constraint are assigned the same color. Ideally a puzzle has only one * solution. * * Your solver should be named as follows: * * sudographSolver(Nodes, Constraints, Color) * *****************************************************************************/ sudographSolver(Nodes, Clusters, Colors) :- assign(Nodes, Colors), valid(Clusters). % assign unifies colors in the second list with nodes in the first. assign([], _). assign([Node | Nodes], Colors) :- member(Node, Colors), assign(Nodes, Colors). % valid checks that all constraints are satisfied. valid([]). valid([Cluster | Clusters]) :- valid1(Cluster), valid(Clusters). % valid checks a single constraint. % The strategy here is that we use setof to sort and remove duplicates. % The result is the same length as the original iff there were no duplicates, % which is to say the constraint is satisfied. valid1(Cluster) :- length(Cluster, N), setof(X, member(X, Cluster), Sorted), % removes duplicates length(Sorted, N). /***************************************************************************** * Part 4: College snack logic problem * algird, bruno, collette, dino, and edwina are each from different * one of five colleges: pomona, pitzer, hmc, cmc, and scripps. * * Each one brings a different snack: jots, snickers, donuts, pez, and spam. * They are all on the train together in seats 1 through 5. * * We want to know which student is in each seat, what college does each * student attend, what did each student bring for a snack? * Construct a Prolog predicate clues of one argument * that yields each solution for the given set of clues, in the form of a * list of triples of the form (Student, College, Snack). * * 1. bruno and dino sat in the end seats. * 2. algird sat next to the student from hmc. * 3. collette sat next to friends with snickers and donuts. * 4. The hmc student brought spam as a snack and sat in the middle seat. * 5. snickers was immediately to the left of pez. * 6. bruno, dino, and algird do not go to scripps. * 7. The pomona student sat between the persons with jots and spam. * 8. dino did not sit next to the person with donuts. * 9. The cmc student did not sit next to edwina. * * Note that negation constraints can't generate, so they must be * tested after the variables are instantiated with values. *****************************************************************************/ /* * Solution to problem number 3, by Bob Keller */ person(P, (P, _, _)). school(S, (_, S, _)) :- member(S, [cmc, hmc, pitzer, pomona, scripps]). snack(S, (_, _, S)). % 1. bruno and dino sat in the end seats. clue1(L) :- person(bruno, B), person(dino, D), ( L = [B, _, _, _, D] ; L = [D, _, _, _, B] ). % 2. algird sat next to the student from hmc. clue2(L) :- person(algird, A), school(hmc, H), nextto(A, H, L). % 3. collette sat next to friends with snickers and donuts. clue3(L) :- person(collette, C), snack(snickers, S), snack(donuts, D), nextto(C, S, L), nextto(C, D, L). % 4. The hmc student brought spam as a snack and sat in the middle seat. clue4(L) :- school(hmc, H), snack(spam, H), L = [_, _, H, _, _]. % 5. snickers was immediately to the left of pez. clue5(L) :- snack(snickers, S), snack(pez, P), leftof(S, P, L). % 6. bruno, dino, and algird do not go to scripps. clue6(L) :- school(scripps, S), member(S, L), \+person(bruno, S), \+person(dino, S), \+person(algird, S). % 7. The pomona student sat between the persons with jots and spam. clue7(L) :- school(pomona, P), snack(jots, J), snack(spam, S), between(P, J, S, L). % 8. dino did not sit next to the person with donuts. clue8(L) :- member(U, L), snack(donuts, U), member(D, L), person(dino, D), \+ nextto(U, D, L). % 9. The cmc student did not sit next to edwina. clue9(L) :- member(C, L), school(cmc, C), member(E, L), person(edwina, E), \+ nextto(C, E, L). % This ensures that all schools appear in the list. % Without this, we can get unbound variables in the solution, % as the constraints don't remove all ambiguities. allSchoolsRepresented(L) :- school(cmc, CMC), member(CMC, L), school(hmc, HMC), member(HMC, L), school(pitzer, Pitzer), member(Pitzer, L), school(pomona, Pomona), member(Pomona, L), school(scripps, Scripps), member(Scripps, L). % Assume that "left of" means "immediate left of". leftof(X, Y, [X, Y | _]). leftof(X, Y, [_ | L]) :- leftof(X, Y, L). rightof(X, Y, L) :- leftof(Y, X, L). nextto(X, Y, L) :- leftof(X, Y, L). nextto(X, Y, L) :- leftof(Y, X, L). between(X, Y, Z, L) :- nextto(X, Y, L), nextto(X, Z, L). snacks(L) :- clue1(L), clue2(L), clue3(L), clue4(L), clue5(L), clue7(L), clue8(L), clue9(L), clue6(L), allSchoolsRepresented(L), true. acidtestSnacks :- snacks([Triple1, Triple2, Triple3, Triple4, Triple5]) -> ( write('snacks:'), nl, write(Triple1), nl, write(Triple2), nl, write(Triple3), nl, write(Triple4), nl, write(Triple5), nl ) ; write('snack acidtest failed'), nl. acidtests1 :- nl, write('ans1: '), ans1(Movie), nl, write(Movie), nl. acidtests1 :- nl, write('ans2: '), ans2(Movie), nl, write(Movie), nl. acidtests1 :- nl, write('ans3: '), ans3(Title), nl, write(Title), nl. acidtests1 :- nl, write('ans4: '), ans4(Person), nl, write(Person), nl. acidtests1 :- nl, write('ans5: '), ans5(Person), nl, write(Person), nl. acidtests1 :- nl, write('ans6: '), ans6(Person), nl, write(Person), nl. acidtests1 :- nl, write('ans7: '), ans7(Actor, Actress), nl, write(Actor), nl, write(' '), nl, write(Actress), nl. acidtests1 :- nl, write('ans8: '), ans8(Actor, Actress), nl, write(Actor), nl, write(' '), nl, write(Actress), nl. acidtests1 :- nl, write('ans9: '), ans9(Person), nl, write(Person), nl. acidtests1 :- nl, write('ans10: '), ans10(List), nl, write(List), nl. acidtests1 :- nl, write('ans11: '), ans11(Person), nl, write(Person), nl. acidtests1 :- nl, write('ans12: '), ans12(1, 'Liv Tyler', Person), nl, write(1), write(': '), nl, write(Person), nl. acidtests1 :- nl, write('ans12: '), ans12(2, 'Liv Tyler', Person), nl, write(2), write(': '), nl, write(Person), nl. acidtests1 :- nl, write('ans12: '), ans12(3, 'Liv Tyler', Person), nl, write(3), write(': '), nl, write(Person), nl. acidtests1 :- nl, write('ans13: '), ans13(N), nl, write(N), nl. /* The following will be used for acidtesting your sudograph puzzles. */ acidtestSudograph(IdNumber) :- sudographPuzzle(IdNumber, Nodes, Constraints, Colors), write('sudograph number '), write(IdNumber), ( sudographSolver( Nodes, Constraints, Colors) -> ( nl, write('Colors: '), write(Colors), nl, write('Nodes: '), write(Nodes), nl, write('Constraints: '), nl, showConstraints(Constraints) ) ; write(' failed'), nl ). showConstraints([]). showConstraints([Constraint | Constraints]) :- write(' '), write(Constraint), nl, showConstraints(Constraints). % Sudograph puzzles sudographPuzzle(1, Nodes, Constraints, Colors) :- A = red, Nodes = [A, B, C], Constraints = [[A, B], [B, C]], Colors = [red, blue]. sudographPuzzle(2, Nodes, Constraints, Colors) :- A = red, C = green, E = blue, G = yellow, Nodes = [A, B, C, D, E, F, G], Constraints = [[A, B, C], [B, C, D], [C, D, E], [D, E, F], [E, F, G], [G, A, B]], Colors = [red, blue, green, yellow]. sudographPuzzle(3, Nodes, Constraints, Colors) :- B = red, E = green, D = blue, Nodes = [A, B, C, D, E, F, G], Constraints = [[A, B, C, D], [B, C, D, G], [D, E, F, B]], Colors = [red, blue, green, yellow]. % This is a 4x4 sudoku grid sudographPuzzle(4, Nodes, Constraints, Colors) :- X12 = 3, X13 = 1, X23 = 2, X32 = 2, X42 = 1, X43 = 3, Nodes = [X11, X12, X13, X14, X21, X22, X23, X24, X31, X32, X33, X34, X41, X42, X43, X44], Constraints = [[X11, X12, X13, X14], [X21, X22, X23, X24], [X31, X32, X33, X34], [X41, X42, X43, X44], [X11, X21, X31, X41], [X12, X22, X32, X42], [X13, X23, X33, X43], [X14, X24, X34, X44], [X11, X12, X21, X22], [X13, X14, X23, X24], [X31, X32, X41, X42], [X33, X34, X43, X44]], Colors = [1, 2, 3, 4]. acidtestSudograph :- acidtestSudograph(_), fail; true. /* The following will be used for acidtesting your 42 puzzles. */ acidtest42(Name, Var, Query, Desired) :- setof1(Var, Query, Ans), !, ( (nonvar(Ans), Ans == Desired) -> write('*** forty-two acidtest '), write(Name), write(' passed'), nl ; write('*** forty-two acidtest '), write(Name), write(' failed'), nl, write(' desired was '), write(Desired), nl, write(' actual was '), write(Ans), nl ). acidtest42(Name, _Var, _Query, Desired) :- write('*** forty-two acidtest '), write(Name), write(' failed'), nl, write(' desired was '), write(Desired), nl, write(' no answer produced'), nl. setof1(X, G, Z) :- setof(X, G, Z). setof1(X, G, []) :- \+setof(X, G, _). % Acidtest cases acidtest42(1) :- acidtest42(1, Exp, solve42([+, -], [2, 3], 9, Exp), []). % Note: The acidtest above will pass currently, as solve42 produces no solution. acidtest42(2) :- acidtest42(2, Exp, solve42([+, -], [2, 2], 4, Exp), [[+, 2, 2]]). acidtest42(3) :- acidtest42(3, Exp, solve42([*, -], [3, 3], 9, Exp), [[*, 3, 3]]). acidtest42(4) :- acidtest42(4, Exp, solve42([+, *, -], [4, 6], 10, Exp), [[+, 4, 6], [+, 6, 4]]). acidtest42(5) :- acidtest42(5, Exp, solve42([+, *, -], [4, 5, 6], 10, Exp), [ [*, 5, [-, 6, 4]], [*, [-, 6, 4], 5]]). acidtest42(6) :- acidtest42(6, Exp, solve42([+, *], [1, 3, 4, 5], 42, Exp), [ [*, [+, 1, 5], [+, 3, 4]], [*, [+, 1, 5], [+, 4, 3]], [*, [+, 3, 4], [+, 1, 5]], [*, [+, 3, 4], [+, 5, 1]], [*, [+, 4, 3], [+, 1, 5]], [*, [+, 4, 3], [+, 5, 1]], [*, [+, 5, 1], [+, 3, 4]], [*, [+, 5, 1], [+, 4, 3]]]). acidtest42(7) :- acidtest42(7, Exp, solve42([*, +], [3, 5, 5, 2], 105, Exp) , [ [*,3,[*,5,[+,2,5]]], [*,3,[*,5,[+,5,2]]], [*,3,[*,[+,2,5],5]], [*,3,[*,[+,5,2],5]], [*,5,[*,3,[+,2,5]]], [*,5,[*,3,[+,5,2]]], [*,5,[*,[+,2,5],3]], [*,5,[*,[+,5,2],3]], [*,[*,3,5],[+,2,5]], [*,[*,3,5],[+,5,2]], [*,[*,3,[+,2,5]],5], [*,[*,3,[+,5,2]],5], [*,[*,5,3],[+,2,5]], [*,[*,5,3],[+,5,2]], [*,[*,5,[+,2,5]],3], [*,[*,5,[+,5,2]],3], [*,[*,[+,2,5],3],5], [*,[*,[+,2,5],5],3], [*,[*,[+,5,2],3],5], [*,[*,[+,5,2],5],3], [*,[+,2,5],[*,3,5]], [*,[+,2,5],[*,5,3]], [*,[+,5,2],[*,3,5]], [*,[+,5,2],[*,5,3]]] ). acidtest42 :- acidtest42(_), fail; true. acidtests2 :- acidtestSudograph. acidtests3 :- acidtest42. acidtests4 :- acidtestSnacks. acidtest :- acidtests1, fail. acidtest :- acidtests2, fail. acidtest :- acidtests3, fail. acidtest :- acidtests4, fail. acidtest :- true.