Prolog

Source

There are five true and five false statements about the secret number. Each pair of statements contains one true and one false statement. Find the trues, find the falses, and find the number.

1a. I have 2 digits
1b. I am even

2a. I contain a “7”
2b. I am prime

3a. I am the product of two consecutive odd integers
3b. I am one more than a perfect square

4a. I am divisible by 11
4b. I am one more than a perfect cube

5a. I am a perfect square
5b. I have 3 digits

Knowledge Base

riddle :- riddle(1000). riddle(Limit) :- riddle(X, Limit), write_ln(X), printone(X), printtwo(X), printthree(X), printfour(X), printfive(X). riddle(X,N) :- Y is 1, riddle(X,Y,N). riddle(X,Y,_) :- once(oneab(Y)), once(twoab(Y)), once(threeab(Y)), once(fourab(Y)), once(fiveab(Y)), X is Y. riddle(X,Y,N) :- Y1 is Y+1, Y1 =< N, riddle(X,Y1,N). oneab(X) :- twodigits(X), \+even(X). oneab(X) :- \+twodigits(X), even(X). printone(X) :- twodigits(X), write_ln('1a'). printone(X) :- even(X), write_ln('1b'). twoab(X) :- containseven(X), \+isprime(X). twoab(X) :- \+containseven(X), isprime(X). printtwo(X) :- containseven(X), write_ln('2a'). printtwo(X) :- isprime(X), write_ln('2b'). threeab(X) :- oddproduct(X), \+perfectsquareplus(X). threeab(X) :- \+oddproduct(X), perfectsquareplus(X). printthree(X) :- oddproduct(X), write_ln('3a'). printthree(X) :- perfectsquareplus(X), write_ln('3b'). fourab(X) :- diveleven(X), \+perfectcubeplus(X). fourab(X) :- \+diveleven(X), perfectcubeplus(X). printfour(X) :- diveleven(X), write_ln('4a'). printfour(X) :- perfectcubeplus(X), write_ln('4b'). fiveab(X) :- perfectsquare(X), \+threedigits(X). fiveab(X) :- \+perfectsquare(X), threedigits(X). printfive(X) :- perfectsquare(X), write_ln('5a'). printfive(X) :- threedigits(X), write_ln('5b'). twodigits(X) :- X > 9, X < 100. even(X) :- Y is X mod 2, Y = 0. containseven(X) :- atom_chars(X, Y), member('7', Y). isprime(X) :- Y is 2, X > 1, \+divisible(X,Y). oddproduct(X) :- N is X+1, Z is 1, once(sqrt(Y,Z,N)), C is Y mod 2, Y > 0, C = 0. perfectsquareplus(X) :- Z is X-1, perfectsquare(Z). diveleven(X) :- X mod 11 = 0. perfectcubeplus(X) :- Z is X-1, perfectcube(Z). perfectsquare(X) :- Z is 1, once(sqrt(Y,Z,X)), Y > 0. threedigits(X) :- X > 99, X < 1000. divisible(X,Y):- N is Y*Y, N =< X, X mod Y =:= 0. divisible(X,Y):- Y < X, Y1 is Y+1, divisible(X,Y1). sqrt(Y,Z,N) :- X is Z*Z, X = N, Y is Z. sqrt(Y,Z,N) :- X is Z*Z, X > N, Y is 0. sqrt(Y,Z,N) :- X is Z*Z, X < N, Z1 is Z+1, sqrt(Y,Z1,N). perfectcube(X) :- Z is 1, once(cbrt(Y,Z,X)), Y > 0. cbrt(Y,Z,N) :- X is Z*Z*Z, X = N, Y is Z. cbrt(Y,Z,N) :- X is Z*Z*Z, X > N, Y is 0. cbrt(Y,Z,N) :- X is Z*Z*Z, X < N, Z1 is Z+1, cbrt(Y,Z1,N).

Queries

riddle.

Output

Knowledge Base

use_module(library(lists)). /* Divide first element by second, place at head and continue */ process([H1, H2 | Tail], Return, [TH1, TH2 | TTail], Tracking) :- H2 \= 0, Result is H1 / H2, string_assemble(['(', TH1, ' / ', TH2, ')'], TResult), process([Result | Tail], Return, [TResult | TTail], Tracking). /* Multiply first element by second, place at head and continue */ process([H1, H2 | Tail], Return, [TH1, TH2 | TTail], Tracking) :- Result is H1 * H2, string_assemble(['(', TH1, ' * ', TH2, ')'], TResult), process([Result | Tail], Return, [TResult | TTail], Tracking). /* Subtract second element from first, place at head and continue */ process([H1, H2 | Tail], Return, [TH1, TH2 | TTail], Tracking) :- Result is H1 - H2, string_assemble(['(', TH1, ' - ', TH2, ')'], TResult), process([Result | Tail], Return, [TResult | TTail], Tracking). /* Add first element to second, place at head and continue */ process([H1, H2 | Tail], Return, [TH1, TH2 | TTail], Tracking) :- Result is H1 + H2, string_assemble(['(', TH1, ' + ', TH2, ')'], TResult), process([Result | Tail], Return, [TResult | TTail], Tracking). /* As long as there are at least three elements, hold the first element, process the remainder of the list, then place the held element at the head and continue - in order to allow for bracketed operations to be at any point in the equation */ process([H1, H2, H3 | Tail], Return, [TH1, TH2 | TTail], Tracking) :- process([H2, H3 | Tail], SubReturn, [TH2 | TTail], SubTracking), process([H1 | SubReturn], Return, [TH1 | SubTracking], Tracking). /* Single elements are returned unchanged */ process([Return], [Return], [Tracking], [Tracking]). /* For each element and combination of elements in the given list, negate them and return a new list to cover every eventuality */ switch([Head | Tail], [Head | Temp]) :- switch(Tail, Temp). switch([Head | Tail], [Inverse | Temp]) :- switch(Tail, Temp), Inverse is 0 - Head. switch([], []). /* Create every permutation of positive and negative of each provided integer and process each one to brute force it */ equals(Variables, Target, Tracking) :- switch(Variables, VariablesNeg), permutation(VariablesNeg, VariablesNegPerm), process(VariablesNegPerm, [Return], VariablesNegPerm, [Tracking]), Target - Return < 0.000001, Return - Target < 0.000001. equals(Variables, Target) :- equals(Variables, Target, Tracking),!, writeln(Tracking). /* Create a record of the operations being tried */ string_assemble([H1 | Tail], String) :- string_assemble(Tail, StringPartial), string_concat(H1, StringPartial, String). string_assemble([], '').

Queries

equals([3,3,8,8],24).

Output

Knowledge Base

%waiting for a translation of the tube map into facts %line(Line,Train,Route). line('A','E',['A','B','C','D','E']). line('A','A',['E','D','C','B','A']). line('B','E',['B','E']). line('B','B',['E','B']). %route_from(+Route,+From,-RouteFrom). route_from([F|R], F, R) :- R \= []. route_from([S|R], F, RF) :- S \= F, route_from(R, F, RF). %new_route(+LineCurrentlyOn,+TrainCurrentlyOn,+CurrentlyStation,-NewLine,-NewTrain,-NewRouteOn). new_route(LCO,TCO,CS,NL,NT,NRO) :- line(NL,NT,NR), (NL,NT) \= (LCO,TCO), route_from(NR,CS,NRO). %unify_lists(+SingleList,+ListOfLists,-UnifiedListOfLists) unify_lists([],Unify,Unify). unify_lists([X|Y],[],Unify) :- unify_lists(Y,[],Unified), append([[X]],Unified,Unify). unify_lists([X|Y],[A|B],Unify) :- unify_lists(Y,B,Unified), append([X],A,XA), append([XA],Unified,Unify). %continue(+Destination,+RouteSoFar,+LineCurrentlyOn,+TrainCurrentlyOn,+[NextStation|RouteCurrentlyOn], % +StationsCouldHaveReachedByNow,+[StationsWeWouldReachNext|StationsWeCouldBeReachingSoon]). continue(D,[(LCO,TCO,D)|RSF],_,_,_,_,_) :- reverse([(LCO,TCO,D)|RSF],Print), once(print_route(Print)), fail. continue(D,RSF,LCO,TCO,RCO,SCHRBN,[]) :- \+member((_,_,D),RSF), continue(D,RSF,LCO,TCO,RCO,SCHRBN,[[]]). continue(D,RSF,LCO,TCO,[NS|RCO],SCHRBN,[SWWRN|SWCBRS]) :- \+member((_,_,D),RSF), append(SWWRN,SCHRBN,SCHRBN_), \+member(NS,SCHRBN_), \+member((_,_,NS),RSF), continue(D,[(LCO,TCO,NS)|RSF],LCO,TCO,RCO,SCHRBN_,SWCBRS). continue(D,[(LCO,TCO,CS)|RSF],LCO,TCO,RCO,SCHRBN,[SWWRN|SWCBRS]) :- D \= CS, once(unify_lists(RCO,[SWWRN|SWCBRS],[SWWRN_|SWCBRS_])), append(SWWRN_,SCHRBN,SCHRBN_), new_route(LCO,TCO,CS,LCO_,TCO_,RCO_), \+member((LCO_,TCO_,CS),RSF), continue(D,[(LCO_,TCO_,CS),(LCO,TCO,CS)|RSF],LCO_,TCO_,RCO_,SCHRBN_,SWCBRS_). %route_to(+Destination,+CurrentStation). route_between(CS,CS) :- once(new_route('','',CS,_,_,_)), write('You are already at '), write(CS), write('.'), nl, nl, fail. route_between(CS,D) :- CS \= D, new_route('','',CS,LCO,TCO,RCO), continue(D,[(LCO,TCO,CS)],LCO,TCO,RCO,[],[]). %print_route(+Route). print_route([(Line,Train,Station)|Rest]) :- write('Get on a train to '), write(Train), write(' on the '), write(Line), write(' line at '), write(Station), write('.'), nl, print_route((Line,Train),Rest). print_route((Line,Train),[(Line,Train,Station),(Line,Train,NewStation)|Rest]) :- write('Travel through '), write(Station), write('.'), nl, print_route((Line,Train),[(Line,Train,NewStation)|Rest]). print_route((Line,Train),[(Line,Train,Station),(NewLine,NewTrain,Station)|Rest]) :- write('Switch to a train to '), write(NewTrain), write(' on the '), write(NewLine), write(' line at '), write(Station), write('.'), nl, print_route((NewLine,NewTrain),Rest). print_route((Line,Train),[(Line,Train,Station)]) :- write('Get off at '), write(Station), write('.'), nl, nl.

Queries

route_between('A','E').

Output

This requires interaction beyond the scope of this website, so to try the game, please go to the SWISH implementation.

Knowledge Base

:- dynamic colour/1. :- dynamic pegCount/1. :- dynamic turnCount/1. :- dynamic solution/1. :- dynamic guess/1. all_colours([]). all_colours([H|T]) :- colour(H), all_colours(T). get_guess(GuessNo,List) :- turnCount(Turns), write('Guess '),write(GuessNo),write(' of '),write(Turns),write(':'),nl, read(Input), atom_chars(Input,List), pegCount(Pegs), once( length(List,Pegs); ( write('Wrong number of pegs'),nl, fail ) ), once( once(all_colours(List)); ( write('Not all pegs are valid colours'),nl, fail ) ), once( \+guess(List); ( write('Guess has been made before'),nl, fail ) ), assertz(guess(List)). get_guess(GuessNo,List) :- write('Invalid Guess - Try Again'),nl, once(get_guess(GuessNo,List)). get_colours :- write('How many colours do you wish to play with (default is 6, enter from 2 to 10)?'),nl, read(Colours), integer(Colours), Colours >= 2, Colours =< 10, get_colours(Colours). get_colours :- write('Please enter an integer between 2 and 10'),nl, get_colours. get_peg_count :- write('How many pegs do you wish to play with (default is 4, enter from 2 to 8)?'),nl, read(Pegs), integer(Pegs), Pegs >= 2, Pegs =< 8, assertz(pegCount(Pegs)). get_peg_count :- write('Please enter an integer between 2 and 8'),nl, get_peg_count. get_turn_count :- write('How many turns do you wish to play with (default is 12, enter from 2 to 100)?'),nl, read(Turns), integer(Turns), Turns >= 2, Turns =< 100, assertz(turnCount(Turns)). get_turn_count :- write('Please enter an integer between 2 and 100'),nl, get_turn_count. get_colours(ColourCount) :- write('Please enter a character to represent each colour...'),nl, get_colours(1,ColourCount). get_colours(Current,Total) :- Current > Total. get_colours(Current,Total) :- write(Current),write('/'),write(Total),nl, read(Input), once( ( atom_chars(Input,[Colour]), \+colour(Colour), assertz(colour(Colour)), New is Current + 1, get_colours(New,Total) ) ; ( write('Please enter a single character that has not been used before'),nl, get_colours(Current,Total) ) ). get_solution(0,[]). get_solution(Count,[Head|Tail]) :- Next is Count - 1, get_solution(Next,Tail), findall(Colour,colour(Colour),Selection), random_member(Head,Selection). get_solution :- pegCount(Pegs), once(get_solution(Pegs,Solution)), assertz(solution(Solution)). compare_guess(Guess,(Blacks,Whites)) :- solution(Solution), once(get_white_count(Guess,Solution,Matches)), once(get_black_count(Guess,Solution,Blacks)), Whites is Matches - Blacks. get_white_count([],_,0). get_white_count([Head|Tail],Solution,Whites) :- select(Head,Solution,Remainder), get_white_count(Tail,Remainder,Partial), Whites is Partial + 1. get_white_count([_|Tail],Solution,Whites) :- get_white_count(Tail,Solution,Whites). get_black_count([],[],0). get_black_count([Head|Tail],[Head|STail],Blacks) :- get_black_count(Tail,STail,Partial), Blacks is Partial + 1. get_black_count([_|Tail],[_|STail],Blacks) :- get_black_count(Tail,STail,Blacks). start :- once(get_peg_count), once(get_turn_count), once(get_colours), once(get_solution), once(take_turn(0)). take_turn(Turn) :- turnCount(Turn), solution(Solution), write('I\'m sorry, please try again'),nl, write('The solution was '),write(Solution),nl. take_turn(Turn) :- NewTurn is Turn + 1, pegCount(Pegs), get_guess(NewTurn,Guess), ( ( compare_guess(Guess,(Pegs,0)), write('Congratulations!'),nl ); ( compare_guess(Guess,(Blacks,Whites)), write(Blacks),write(' colour'),(Blacks \= 1 -> write('s');true),write(' in the right place and '),write(Whites),write(' colour'),(Whites \= 1 -> write('s');true),write(' in the wrong place'),nl, take_turn(NewTurn) ) ).

Queries

To execute, please go to SWISH and type 'start.'

Output