Given the code below, I am trying to call the last rule: trans([[p],[q],[r]]).
This should then recursively call trans([P]), write, trans([P],[Q]]).
However it appears to be calling trans([P]), write, trans([P,Q]).
Is there a way to override the reserved square bracket? Is there a better way to enable the recursion?
trans([P]) :- atom(P), write(P).
trans([~P]) :- write('Not '), trans([P]).
trans([P,Q]) :- trans(P), write(' or '), trans(Q).
trans([P,Q,R]) :- trans([P]), write(' or '), trans([Q,R]).
trans([P,Q,R,S]) :- trans([P]), write(' or '), trans([Q,R,S]).
trans([[P],[Q]]) :- trans([P]), write(' and '), trans([Q]).
trans([[P,Q],[R]]) :- trans([P,Q]), write(' and '), trans([R]).
trans([[P],[Q,R]]) :- trans([P]), write(' and '), trans([Q,R]).
trans([[P,Q],[R,S]]) :- trans([P,Q]), write(' and '), trans([R,S]).
trans([[P],[Q],[R]]) :- trans([P]), write(' and '), trans([[Q],[R]]).
Terminal Output:
?- trans([[p],[q],[r]]).
p and q or r
true ;
q and r
true .
Perhaps something like this. There's a bit of splitting out of clauses to make the parenthesis come out nice.
% Handle the top, conjunction level
trans([H]) :- % A single atomic conjunctive term
atom(H), write(H).
trans([H]) :- % A single non-atomic conjunctive term
trans_dis(H).
trans([H1,H2|T]) :- % Multiple conjunctive terms
trans_conj([H1,H2|T]).
trans_conj([H1,H2|T]) :- % Multiple conjunctive terms
trans_conj([H1]), write(' and '), trans_conj([H2|T]).
trans_conj([H]) :- % Single atomic conjunctive term
atom(H), write(H).
trans_conj([[H]]) :- % Last conjunctive term, single disjunction
trans_dis([H]).
trans_conj([[H1,H2|T]]) :- % Last conjunctive term, multiple disjunctions
write('('), trans_dis([H1,H2|T]), write(')').
% Handle the disjunctions level
trans_dis([H]) :- % Single disjunctive term
atom(H), write(H).
trans_dis([~H]) :- % Single negated disjunctive term
atom(H), write('not '), write(H).
trans_dis([H1,H2|T]) :- % Multiple disjunctive terms
trans_dis([H1]), write(' or '), trans_dis([H2|T]).
Some test results:
| ?- trans([p]).
p
true ? a
no
| ?- trans([[p]]).
p
true ? a
no
| ?- trans([p,q]).
p and q
true ? a
no
| ?- trans([[p,q]]).
p or q
true ? a
no
| ?- trans([[p],[q]]).
p and q
true ? a
no
| ?- trans([[p,r],[q]]).
(p or r) and q
true ? a
no
| ?- trans([[p,r],[q,s]]).
(p or r) and (q or s)
| ?- trans([[a,~b,c],[d,e],[f]]).
(a or not b or c) and (d or e) and f
true ? a
(1 ms) no
You query:
?- trans([[p],[q],[r]]).
gets instantiated with
trans([P,Q,R]) :- trans([P]), write(' or '), trans([Q,R]).
(or: the 4th clause of trans/1). You want it to instantiate with
trans([[P],[Q],[R]]) :- trans([P]), write(' and '), trans([[Q],[R]]).
(or: the 10th clause of trans/1).
The reason why this happens is that trans([[p],[q],[r]]) unifies with [P,Q,R] according to the following substitution: P = [p], Q = [q], and R = [r].
Proper use of recursion
Your code looks a little verbose for Prolog code. I therefore give a possible rewrite here that uses recursion proper.
Instead of:
trans([P,Q]) :- trans(P), write(' or '), trans(Q).
trans([P,Q,R]) :- trans([P]), write(' or '), trans([Q,R]).
trans([P,Q,R,S]) :- trans([P]), write(' or '), trans([Q,R,S]).
you can also write:
trans([]).
trans([H|T]):-
trans(H),
trans(T).
... and that works for any list argument that is given to trans/1.
Distinguish disjunction from conjunction
You are not making the distinction between conjunction and disjunction correctly yet, you may want to try out:
trans(and([]).
trans(and([H])):-
trans(H).
trans(and([H|T])):-
trans(H),
write(' and '),
trans(and(T)).
trans(or([])).
trans(or([H])):-
trans(H).
trans(or([H|T])):-
trans(P),
write(' or '),
trans(or(T)).
Related
This is the current code I have for a problem I am working on. It is supposed to read in from a file, and increment a counter, R, every time it comes across a vowel.
Currently, I have it stop when reaching a vowel, but I would like it to increment a counter, then continue processing. Once done, I want it to print R to the console. Thanks in advance!
readWord(InStream, W) :-
get0(InStream,Char),
checkChar_readRest(Char,Chars,InStream, R),
atom_codes(Code,Chars),
write(Code).
%checkChar_readRest(10,[],_) :- !. % Return
%checkChar_readRest(32,[],_) :- !. % Space
checkChar_readRest(-1,[],_,_) :- !. % End of Stream
checkChar_readRest(97,[],_,R) :- !. % a
checkChar_readRest(101,[],_,R) :- !. % e
checkChar_readRest(105,[],_,R) :- !. % i
checkChar_readRest(111,[],_,R) :- incr(R,R1), write(R1). % o
checkChar_readRest(117,[],_,R) :- !. % u
%checkChar_readRest(end_of_file,[],_,_) :- !.
checkChar_readRest(Char,[Char|Chars],InStream,R) :-
get0(InStream,NextChar),
checkChar_readRest(NextChar,Chars,InStream,R).
incr(X, X1) :- X1 is X+1.
vowel(InStream, R) :-
open(InStream, read, In),
repeat,
readWord(In, W),
close(In).
Here's my attempt (ISO predicates):
% open Src, count vowels, close stream, print to console
count_vowels_in(Src) :-
open(Src, read, Stream),
count(Stream, Total),
close(Stream),
% cutting here because our Stream is now closed, any backtracking will break things that rely on it
% you could also put this after at_end_of_stream/1 in count_/3
% not sure what best practices are here
!,
write(Total).
% just a nice wrapper to get started counting with the initial count set to 0
count(Stream, Total) :-
count_(Stream, 0, Total).
% at end of stream, Count = Total and we're done
count_(Stream, Count, Count) :-
at_end_of_stream(Stream).
% read from stream recursively, incrementing Count as needed
count_(Stream, Count0, Total) :-
\+at_end_of_stream(Stream),
get_char(Stream, Char),
char_value(Char, Value),
Count1 is Count0 + Value,
% recursively call count_, but now with our new Count1 value instead, carrying forward the results
count_(Stream, Count1, Total).
char_value(Char, 1) :-
vowel(Char).
char_value(Char, 0) :-
\+vowel(Char).
vowel(a).
vowel(e).
vowel(i).
vowel(o).
vowel(u).
The biggest difference is that I use two variables for keeping track of the count. Count (equivalent to your R) is the current count, and Total is a variable representing the final count. We unify Total with Count when we are finished counting: at the end of the stream.
In the original program posted, there were many singleton variables (variables that are never unified with anything, for example W). This is usually indicative of a bug and will generate warnings. Remember that Prolog is a logical language, it can be good to take a step back and think "what am I actually trying to do with these variables?". It can also help to break the problem down into smaller chunks instead of trying to write one predicate that does everything.
I might approach it like this:
Slurp in the entire file as a list of characters.
Traverse that list and tally the vowels it contains.
Write the tally.
Something like
findall(C, ( get0(V) , V \= -1 , char_code(C,V) ), Cs).
should suffice for slurping the text.
And then, something along these lines:
count_vowels :-
findall(C, ( get0(V) , V \= -1 , char_code(C,V) ), Cs),
count_vowels(Cs,N),
writeln( total_vowels : N )
.
count_vowels( S , N ) :- string(S), !, string_chars(S,Cs), count_vowels(Cs,N) .
count_vowels( Cs , N ) :- count_vowels(Cs,0,N) .
count_vowels( [] , N , N ) .
count_vowels( [C|Cs] , T , N ) :- tally(C,T,T1), count_vowels(Cs,T1,N).
tally( C , M , N ) :- vowel(C), !, N is M+1 .
tally( _ , N , N ) .
vowel( a ).
vowel( e ).
vowel( i ).
vowel( o ).
vowel( u ).
I tried to generate all the combinations of the elements in two lists.
For example, List([1,2,3],[1,2,3],L). should return L = [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
This is the code I wrote:
matrix(L1, L2, M, Res).
matrix([], L2, [], []).
matrix([H1|T1], L2, M, [M|Res]):- matrix(T1, L2, M_temp, Res), combo(L2, H1, [], M).
combo ([], _, Acc, Acc) :- !.
combo ([H2|T2], H_tmp, Acc, M) :- combo (T2, H_tmp, Acc, M_tmp), M = [[H_tmp,H2]|M_tmp].
but the result is: L = [[[1,1],[1,2],[1,3]],[[2,1],[2,2],[2,3]],[[3,1],[3,2],[3,3]]]
because I add the list as element instead of append each list element to Res. No success of implementing the the append.
append([1,2,3],[1,2,3],L).
append_lst([], L2, L2).
append_lst([H|T], L2, Res) :- append_lst(T, L2, Acc), Res = [H|Acc].
I think my approach is wrong.
Could you help me, please?
Well, Prolog doesn't have arrays: it just has lists. But, assuming your have two lists/sets, say
[1,2,3]
[a,b,c]
and want to generate a list containing the Cartesian product of the two sets:
[
[1,a], [1,b], [1,c],
[2,a], [2,b], [2,c],
[3,a], [3,b], [3,c],
]
The simplest way is to use findall/3 and member/2:
matrix( Xs, Ys, M ) :- findall( [X,Y] , ( member(X,Xs), member(Y,Ys) ) , M ).
And if you wanted to roll your own, it's not much more difficult. You might notice that we're using a helper predicate with an additional argument that will give us back the unbound tail of the list we're building, which gets closed when we run out of Xs.
Here's the code:
pairs( [] , _ , [] ) . % Once we exhausted the Xs, we're done.
pairs( [X|Xs] , Ys , Ps ) :- % But if we have an X, then...
pair(X,Ys,Ps, P0 ), % - pair that X with every Y, and
pairs(Xs,Ys,P0) % - and recurse down
. % Easy!
pair( _ , [] , Ps , Ps ) . % Once we've exhausted the Ys, we're done
pair( X , [Y|Ys] , [X:Y|Ps] , P0 ) :- % Otherwise, construct the X:Y pair, and
pair(X,Ys,Ps,P0) % - recurse down.
. % Even easier!
I am writing a program in prolog that should interact with the user. I have a database of bands that I like and that I dislike, and I can ask prolog about these bands. First I have to say
hello.
to prolog, and prolog answers hello and I can start asking questions like
do you like the band motorhead?
and prolog should answer
yes i like the band because it is rock.
Then I should be able to ask another question.
My initial idea to achieve this was to get the last word of the question, check if it is in one of the two list (liked-list or disliked-list), and then recursively call the function to interact with the program.
In fact my code works well, except for one annoying detail that I can't solve. Here is my problem:
?- hello.
hello!
Ask your question: do you like the band motorhead?
I like the band because it is metal.
Ask your question: I don't know that band.
Ask your question: do you like the band motorhead
I like the band because it is metal.
In fact when I add a question mark at the end of the question, prolog answers the question (no problem here), recursively call the function to ask questions, and then adds "I don't know that band" and calls once again the function to ask questions instead of calling it once, and waiting for me to type another question.
Here is my current code for interacting with prolog
hello :- write('hello!'),nl, ask.
ask :- write('Ask your question: '),
getsentence(X), last(Word, X),
process(Word).
process(stop) :- !.
process(hello) :- hello, !.
process(X) :-
(like-list(LikeList), member(X, LikeList), type(X, Style),
write('I like the band because it is '), write(Style), write('.'), nl
;
dislike-list(DisLikeList), member(X, DisLikeList),
write('I don\'t like that band.'), nl
;
write('I don\'t know that band.'), nl),
ask.
And here is my current code for parsing what the user types:
getsentence( Wordlist) :-
get0( Char),
getrest( Char, Wordlist).
getrest( 46, [] ) :- !. % End of sentence: 46 = ASCII for '.'
getrest( 63, [] ) :- !. % 63 = ASCII for '?'
getrest( 10, [] ) :- !. % 10 = ASCII for '\n'
getrest( 13, [] ) :- !. % 13 = ASCII for 'CR'
getrest( 32, Wordlist) :- !, % 32 = ASCII for blank
getsentence( Wordlist). % Skip the blank
getrest( Letter, [Word | Wordlist] ) :-
getletters( Letter, Letters, Nextchar), % Read letters of current word
name( Word, Letters),
getrest( Nextchar, Wordlist).
getletters( 46, [], 46) :- !. % End of word: 46 = full stop
getletters( 63, [], 63) :- !.
getletters( 10, [], 63) :- !.
getletters( 13, [], 63) :- !.
getletters( 32, [], 32) :- !. % End of word: 32 = blank
getletters( Let, [Let | Letters], Nextchar) :-
get0( Char),
getletters( Char, Letters, Nextchar).
last(Item, List) :- append(_, [Item], List),!.
Ok I managed to solve my problem by taking a different approach.
I hope this will be of any use to anyone.
hello :-
write_ln('Robot: Hello!'),
ask.
/* read_line_to_codes converts what the user typed to ASCII codes, and then
* with atom_codes, I reconstruct the question from the list of ASCII codes.
*/
ask :-
write('Me: '),
read_line_to_codes(user_input, Codes),
atom_codes(X, Codes),
process(X), !.
process(stop) :- !.
process(hello) :- hello.
process(X) :-
((sub_atom(X, _, _, _, 'do you like the band '),
like-list(List),
searchForLikes(X, List, Band, Style),
write('Robot: '),
write('I like '),
write(Band),
write(' because it is '),
write(Style), write_ln('.')
);
(sub_atom(X, _, _, _, 'do you like the band '),
dislike-list(List),
searchForDislikes(X, List, Band, Style),
write('Robot: '),
write('I don\'t like '),
write(Band),
write(' because it is '),
write(Style), write_ln('.')
);
(X=='what bands do you like?',
like-list(LikeList),
write_ln(LikeList)
);
(X=='what bands don\'t you like?',
dislike-list(DislikeList),
write_ln(DislikeList)
);
(sub_atom(X, _, _, _, 'do you like the band '),
write('Robot: '),
write_ln('I don\'t know that band.')
);
(write('Robot: '),
write_ln('I don\'t understand the question.'))
),
ask.
/*
* term_to_atom transforms for example "ac-dc" to "'ac-dc'" in order to look for that particular atom in the String.
* The lookup is done with the function sub_atom (it searches the Band in the string X).
*/
searchForLikes(_, [], _) :- !, fail.
searchForLikes(X, [Head|Tail], Band, Style) :-
(term_to_atom(Head, Band),
sub_atom(X, _, _, _, Band),
type(Head, Style),
!);
searchForLikes(X,Tail, Band, Style).
searchForDislikes(_, [], _) :- !, fail.
searchForDislikes(X, [Head|Tail], Band, Style) :-
(term_to_atom(Head, Band),
sub_atom(X, _, _, _, Band),
type(Head, Style),
!);
searchForDislikes(X,Tail, Band, Style).
The main difference of this code with the first one is the use of built in functions.
I have this code where I want to print a board in the console. The code is working as expected in terms of printing it but in the end of doing so it returns "no", instead of yes. How can I make this recursion return true?
Main code:
printLine(_,Size,Size).
printLine([H1,H2|R],Size,Indice) :-
write(H1), write(' '), write(H2), write(' '),
IndiceNovo is Indice+1,
printLine(R,Size,IndiceNovo).
printTops([]).
printTops([H|T]) :- write(H),write(' '),printTops(T).
printBoard(_,_,Size,Size*2,_):- nl,nl, write('end').
printBoard(Numeros,Topos,Size,Indice,BarrelIndex):-
calculateDiv(Size,D), nl,
writeDiv(D), nl,
TopoIndex1 is (1+BarrelIndex*Size),
TopoIndex2 is (Size + BarrelIndex*Size),
slice(Topos,TopoIndex1,TopoIndex2,TopsTemp),
write(' '), printTops(TopsTemp),nl,
Indice2 is Indice+1,
Index1 is (1+Indice*Size*2), Index2 is (Size*2 + (Indice*Size*2)),
slice(Numeros,Index1,Index2,Linha),
printLine(Linha,Size,0),nl,
Index21 is (1+(Indice2*Size*2)), Index22 is (Size*2 + (Indice2*Size*2)),
slice(Numeros,Index21,Index22,Linha2),
printLine(Linha2,Size,0),nl,
IndiceNovo is Indice+2, NovoBarrelIndex is BarrelIndex+1,
printBoard(Numeros,Topos,Size,IndiceNovo,NovoBarrelIndex).
printBoard(Board,Topos):-
length(Topos,Size),
Size1 is truncate(sqrt(Size)),
printBoard(Board,Topos,Size1,0,0).
Test Code:
p:-
B= [1,2,3,4,5,6,7,8,3,4,1,5,7,8,2,6,2,1,4,3,6,7,8,5,5,7,6,8,1,3,4,2,4,6,8,7,3,2,5,1,7,8,2,1,4,5,6,3,6,3,5,2,8,4,1,7,8,5,7,6,2,1,3,4],
T= [10,13,26,23,15,21,17,19,25,18,14,90,22,20,64,84],
printBoard(B,T).
My output:
you need to evaluate arithmetic with is/2.
printBoard(_,_,Size,Size2,_):- Size2 is Size*2, nl,nl, write('end').
Prolog, recursive function:
i want it to print the C with each element of the list
for example: C=30 and [H|T]= [-9,-10,-30]
myfunc(C,[H|T]):-
(\+([H|T]=[])),
write(C), write(' with '), write(H), nl,
myfunc(C,T).
i check at the beginning that the head of the list is not empty. it gives me this output
30 with -9
30 with -10
30 with -30
(32 ms) no
this output is what i want but i dont want to get a 'no' at the end because this makes the parent function to fail as well!
how can i remove it and put a 'yes' instead?
Simple way: just add a base case with the empty list.
myfunc(_, []) :- !.
myfunc(C,[H|T]):-
write(C), write(' with '), write(H), nl,
myfunc(C,T).
test:
?- myfunc(30, [1, 2, 3]).
30 with 1
30 with 2
30 with 3
true.
I don't know if this is the best way to do that, but you didn't give us much details about your whole program, so I opted for a small modification of your predicate.
If you have maplist in your Prolog, you can write
myfunc(N, L) :-
maplist(my_write(N), L).
my_write(N, Val) :-
format('~w with ~w~n', [N, Val]).
With SWI-Prolog and module lambda
:- use_module(library(lambda)).
myfunc(N, L) :-
maplist(\X^format('~w with ~w~n', [N, X]), L).