Related
I have some prolog codes, I print processes on terminal. Also I write to file, what I print on terminal. I put write to file functs, near every write funct. But they are not same. Writing file is not working well.
printrow([]) :- write(' '),
open('output.txt',append,OS), write(OS,' '), close(OS).
% I try to put same process for file
printrow([X|Xs]) :- printrepl(X,Y), write(' '), write(Y),
printrow(Xs), open('output.txt', append,OS),
write(OS,' '), write(OS,Y), close(OS).
printrepl(' ',' ') :- !.
printrepl(x,'X').
printrows([]) :- nl.
printrows([N|Ns]) :- write(N), write(' '),
open('output.txt', append,OS), write(OS,N), write(OS,' '),
printrows(Ns), write(OS,' \n'), close(OS).
% I can't find alternative for writef('%2r w',[X]) below,
% for writing file, I think there is bug
writek(K,List) :- nth1(K,List,X), !, writef('%2r w',[X]),
open('output.txt',append,OS), write(OS,' '), write(OS,X), close(OS).
writek(_,_) :- write(' '),
open('output.txt',append,OS),write(OS,' '), close(OS).
Can you give me advice for writing same outputs with terminal?
Here is a rewrite for writek and printrows. This could be of use.
% ---
% Printing rows (as "~w", equal to write/1) to stream Stream
% ---
printrows([],Stream) :-
format(Stream,"~n",[]).
printrows([N|Ns],Stream) :-
format(Stream,"~w ~n",[N]),
printrows(Ns,Stream).
% ---
% Printing/Appending Rows to the file named by Filename
% ---
printrows_to_file(Filename,Rows) :-
setup_call_cleanup(
open(Filename, append, Stream), % NB append
printrows(Rows,Stream),
close(Stream)).
% ---
% Printing Rows to stdout
% ---
printrows_to_stdout(Rows) :-
printrows(Rows,user_output).
% ---
% Write "w", indented by 1-based value of List[K]
% ---
writek(K,List,Stream) :-
nth1(K,List,Element),
!,
forall(between(1,Element,_),format(Stream," ",[])), % Indent
format(Stream,"w~n",[]).
writek_to_file(Filename,K,List) :-
setup_call_cleanup(
open(Filename, append, Stream), % NB append
writek(K,List,Stream),
close(Stream)).
writek_to_stdout(K,List) :-
writek(K,List,user_output).
For example:
?- printrows_to_stdout([1,2,3]).
1
2
3
true.
?- writek_to_stdout(1,[4,5,6]).
w
true.
Similarly for
?- printrows_to_file('filename.txt',[1,2,3]).
?- writek_to_file('filename.txt',1,[4,5,6]).
I have the following code :
size(5).
black(1,3).
black(2,3).
black(3,2).
black(4,3).
black(5,1).
black(5,5).
words([do,ore,ma,lis,ur,as,po, so,pirus, oker,al,adam, ik]) .
:- use_module(library(lists),[nth1/3, select/3]).
crossword(Puzzle) :-
words(WordList),
word2chars(WordList,CharsList),
make_empty_words(EmptyWords) ,
fill_in(CharsList,EmptyWords),
word2chars(Puzzle,EmptyWords).
word2chars([],[]).
word2chars([Word|RestWords] ,[Chars|RestChars] ) :-
atom_chars(Word,Chars),
word2chars(RestWords,RestChars).
fill_in([],[]).
fill_in([Word|RestWords],Puzzle) :-
select(Word,Puzzle,RestPuzzle),
fill_in(RestWords,RestPuzzle).
make_empty_words(EmptyWords) :-
size(Size),
make_puzzle(Size,Puzzle),
findall(black(I,J),black(I,J),Blacks) ,
fillblacks(Blacks,Puzzle),
empty_words(Puzzle,EmptyWords).
make_puzzle(Size,Puzzle) :-
length(Puzzle,Size),
make_lines(Puzzle,Size).
make_lines([],_).
make_lines([L|Ls],Size) :-
length(L,Size),
make_lines(Ls,Size).
fillblacks([],_).
fillblacks([black(I,J)|Blacks],Puzzle) :-
nth1(I,Puzzle,LineI),
nth1(J,LineI,black),
fillblacks(Blacks,Puzzle).
empty_words(Puzzle,EmptyWords) :-
empty_words(Puzzle,EmptyWords,TailEmptyWords),
size(Size),
transpose(Size,Puzzle,[],TransposedPuzzle),
empty_words(TransposedPuzzle,TailEmptyWords,[] ).
empty_words([],Es,Es).
empty_words([L|Ls],Es,EsTail) :-
empty_words_on_one_line(L,Es,Es1) ,
empty_words(Ls,Es1,EsTail).
empty_words_on_one_line([], Tail, Tail).
empty_words_on_one_line([V1,V2|L],[[V1,V2|Vars]|R],Tail) :-
var(V1), var(V2), !,
more_empty(L,RestL,Vars),
empty_words_on_one_line(RestL,R,Tail) .
empty_words_on_one_line([_| RestL],R, Tail) :-
empty_words_on_one_line(RestL,R,Tail) .
more_empty([],[],[]).
more_empty([V|R],RestL,Vars) :-
( var(V) ->
Vars = [V|RestVars],
more_empty(R,RestL,RestVars)
;
RestL = R,
Vars = []
).
transpose(N,Puzzle,Acc,TransposedPuzzle) :-
( N == 0 ->
TransposedPuzzle = Acc
;
nth_elements(N,Puzzle,OneVert),
M is N - 1,
transpose(M,Puzzle,[OneVert|Acc], TransposedPuzzle)
).
nth_elements(_,[],[]).
nth_elements(N,[X|R],[NthX| S]) :-
nth1(N,X,NthX),
nth_elements(N,R,S).
It is used for solving a crossword like this:
The black squares places are given by default in the code but I want to find a way to give the black squares places by input when I want to query crossword.
something like this:
black(Y1,X1).
black(Y2,X2).
black(Y3,X3).
black(Y4,X4).
black(Y5,X5).
black(Y6,X6).
crossword(Puzzle,Y1,X1,Y2,X2,...) :-
words(WordList),
word2chars(WordList,CharsList),
make_empty_words(EmptyWords,Size) ,
fill_in(CharsList,EmptyWords),
word2chars(Puzzle,EmptyWords).
As #lurker mentioned I tried rewriting the code and giving the black squares as input to program as below:
:- use_module(library(lists),[nth1/3, select/3]).
crossword(Puzzle,Size,Blacks,WordList) :-
word2chars(WordList,CharsList),
make_empty_words(EmptyWords,Size,Blacks) ,
fill_in(CharsList,EmptyWords),
word2chars(Puzzle,EmptyWords).
word2chars([],[]).
word2chars([Word|RestWords] ,[Chars|RestChars] ) :-
atom_chars(Word,Chars),
word2chars(RestWords,RestChars).
fill_in([],[]).
fill_in([Word|RestWords],Puzzle) :-
select(Word,Puzzle,RestPuzzle),
fill_in(RestWords,RestPuzzle).
make_empty_words(EmptyWords,Size,Blacks) :-
make_puzzle(Size,Puzzle),
fillblacks(Blacks,Puzzle),
empty_words(Puzzle,EmptyWords).
make_puzzle(Size,Puzzle) :-
length(Puzzle,Size),
make_lines(Puzzle,Size).
make_lines([],_).
make_lines([L|Ls],Size) :-
length(L,Size),
make_lines(Ls,Size).
fillblacks([],_).
fillblacks([black(I,J)|Blacks],Puzzle) :-
nth1(I,Puzzle,LineI),
nth1(J,LineI,black),
fillblacks(Blacks,Puzzle).
empty_words(Puzzle,EmptyWords) :-
empty_words(Puzzle,EmptyWords,TailEmptyWords),
transpose(Size,Puzzle,[],TransposedPuzzle),
empty_words(TransposedPuzzle,TailEmptyWords,[] ).
empty_words([],Es,Es).
empty_words([L|Ls],Es,EsTail) :-
empty_words_on_one_line(L,Es,Es1) ,
empty_words(Ls,Es1,EsTail).
empty_words_on_one_line([], Tail, Tail).
empty_words_on_one_line([V1,V2|L],[[V1,V2|Vars]|R],Tail) :-
var(V1), var(V2), !,
more_empty(L,RestL,Vars),
empty_words_on_one_line(RestL,R,Tail) .
empty_words_on_one_line([_| RestL],R, Tail) :-
empty_words_on_one_line(RestL,R,Tail) .
more_empty([],[],[]).
more_empty([V|R],RestL,Vars) :-
( var(V)
-> Vars = [V|RestVars],
more_empty(R,RestL,RestVars)
; RestL = R,
Vars = []
).
transpose(N,Puzzle,Acc,TransposedPuzzle) :-
( N == 0
-> TransposedPuzzle = Acc
; nth_elements(N,Puzzle,OneVert),
M is N - 1,
transpose(M,Puzzle,[OneVert|Acc], TransposedPuzzle)
).
nth_elements(_,[],[]).
nth_elements(N,[X|R],[NthX| S]) :-
nth1(N,X,NthX),
nth_elements(N,R,S).
now by the following input the code returns the answer to the puzzle:
crossword(Puzzle,5,[black(1,3),black(2,3),black(3,2),black(4,3),
black(5,1),black(5,5)],[do,ore,ma,lis,ur,as,pu, so,pirus, uker,al,adam, ik]).
And the output will be:
Puzzle = [as,pu,do,ik,ore,ma,ur,lis,adam,so,al,pirus,uker]
Very nice, +1 for solving it yourself.
In addition, I would like to show you how to use DCGs to obtain predicates with fewer arguments for empty_words/2 and its related predicates, which are therefore easier to understand. Further, transpose/2 is already available as a library predicate in SICStus Prolog and SWI (see its source code if you are interested in how it is implemented), so I use that instead. Notice that size/1 is no longer necessary.
:- use_module(library(clpfd)). % for transpose/2 in SWI-Prolog
empty_words(Puzzle,EmptyWords) :-
phrase(empty_words(Puzzle), EmptyWords, RestEmptyWords),
transpose(Puzzle, TransposedPuzzle),
phrase(empty_words(TransposedPuzzle), RestEmptyWords).
empty_words([]) --> [].
empty_words([L|Ls]) --> empty_words_on_one_line(L), empty_words(Ls).
empty_words_on_one_line([]) --> [].
empty_words_on_one_line([V1,V2|Ls0]) -->
{ var(V1), var(V2) }, !,
[[V1,V2|Vars]],
{ more_empty(Ls0, Ls, Vars) },
empty_words_on_one_line(Ls) .
empty_words_on_one_line([_|Ls]) --> empty_words_on_one_line(Ls).
The other predicates remain unchanged.
Your fill_in/2 is available as permutation/2.
maplist/2 can help you in other places, like:
maplist(length_list(Size), Puzzle)
to replace make_lines/2 with a short definition of length_list/2 that I leave as a simple exercise.
I'm trying to read words from input and store each word in a list. Then I want to count the vowels in each word and write the count into a file.
Here is what I did so far:
readWord(InStream,W) :- get0(InStream,Char),
checkCharAndReadRest(Char,Chars,InStream)
% ,program(Chars),
,checkChars(Chars) ,
atom_chars(W,Chars).
%checkChars(Chars):- member([97,101,105,111,117] , Chars).
checkChars(Chars):- member(97, Chars).
checkCharAndReadRest(10,[],_) :- !. % Return
checkCharAndReadRest(32,[],_) :- !. % Space
checkCharAndReadRest(-1,[],_) :- !. % End of Stream
checkCharAndReadRest(end_of_file,[],_) :- !.
checkCharAndReadRest(Char,[Char|Chars],InStream) :-
get0(InStream,NextChar),
checkCharAndReadRest(NextChar,Chars,InStream).
writeWord(end_of_file).
writeWord(X) :- write(X),nl.
readFile :-
open('c:/sample.txt', read, In),
repeat,
readWord(In,W),
writeWord(W),
W == end_of_file,
!,
close(In).
member(X, [ _ | Z]):-member(X, Z).
member(X, [X | _ ]):-increment(0,N).
increment(N0,N):- N is N0+1,write(N).
%program(Chars) :-
%open('e:/outputfile.txt',write, Stream),
%write(Stream,X),
%close(Stream).
The words are stored perfectly in lists, but I don't know how to count them each time
and send the count to a file.
I'm attempting to write a Prolog meta-interpreter to choose the order of goal execution, for example executing first all goals with the minimum number of parameters.
I started from the vanilla meta-interpreter:
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- solve2(A), solve2(B).
solve2(A) :- clause(A,B), solve2(B).
Then i went to something like
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- count(A,Args), count(B,Args2), Args<Args2, solve2(A), solve2(B).
solve2((A,B)) :- count(A,Args), count(B,Args2), Args>Args2, solve2(B), solve2(A).
solve2(A) :- clause(A,B), solve2(B).
But if the 4th line is executed then the whole block B is executed before A which is wrong.
Ex. A=a(x,y), B=(b(x,y,z), c(x)) I'd like to execute c, then a, then b. - while in this method i'd get c, b and then a.
I'm thinking about transforming the goals in a list but i'm not too sure.
Any ideas?
Here is an (untested) vanilla meta interpreter, with conjunction order changed. I would be glad if you could try with your data.
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- ordering(A,B, C,D), ! /* needed */, solve2(C), solve2(D).
solve2(A) :- clause(A,B), solve2(B).
ordering(A,B, C,D) :-
minargs(A, NA),
minargs(B, NB),
( NA =< NB -> C/D=A/B ; C/D=B/A ).
minargs((A,B), N) :-
minargs(A, NA),
minargs(B, NB),
!, ( NA =< NB -> N=NA ; N=NB ).
minargs(T, N) :-
functor(T, _, N).
edit I tested with this setting:
builtin(writeln(_)).
a(1):-writeln(1).
b(1,2):-writeln(2).
c(1,2,3):-writeln(3).
test :-
solve2((c(A,B,_),a(A),b(A,B))).
and got the expected output:
?- test.
1
2
3
true .
edit I had to resort to a list representation, but then it make sense to preprocess the clauses and get the right order before, then stick to plain vanilla interpreter:
test :-
sortjoin((b(A,B),a(A),c(A,B,_)), X),
solve2(X).
sortjoin(J, R) :-
findall(C-P, (pred(J, P), functor(P,_,C)), L),
sort(L, T),
pairs_values(T, V),
join(V, R).
join([C], C).
join([H|T], (H,R)) :- join(T, R).
pred((A, _), C) :-
pred(A, C).
pred((_, B), C) :-
!, pred(B, C).
pred(C, C).
where solve2((A,B)) :- ... it's the original solve2(A),solve2(B)
I'm trying to make a prolog function. The function reads in a sentence, and then tries to extract a key word. If a key word is found, it prints a message. I want it to also print a message if no keywords are found. Here is my example :
contains([word1|_]) :- write('word1 contained').
contains([Head|Tail]) :- Head \= word1, contains(Tail).
contains([word2|_]) :- write('word2 contained').
contains([Head|Tail]) :- Head \= word2, contains(Tail).
contains([word3|_]) :- write('word3 contained').
contains([Head|Tail]) :- Head \= word3, contains(Tail).
The above code will check and see if the extracted word is present. But it does not give an answer if the words 'word1,word2 or word3' are not contained. Does anybody know how I should go about implementing this?
I tried adding :
contains([_|_]) :- write('nothing contained'),nl.
contains([Head|Tail]) :- Head \= _, contains(Tail).
But clearly this is the wrong thing to do.
The standard way to write the main part of your contains predicate is:
contains([word1|_]) :- !, write('word1 contained').
contains([word2|_]) :- !, write('word2 contained').
contains([word3|_]) :- !, write('word3 contained').
contains([Head|Tail]) :- contains(Tail).
Which means:
when you find a word, don't search any further (this is what the cut (!) operator is for).
when nothing else worked, recurse on tail.
To add an answer in case nothing is found, just add another cut on the recursive call, so that the later case is only called when nothing else (including recursion) worked:
contains([word1|_]) :- !, write('word1 contained').
contains([word2|_]) :- !, write('word2 contained').
contains([word3|_]) :- !, write('word3 contained').
contains([Head|Tail]) :- contains(Tail), !.
contains(_) :- write('Nothing found').
In imperative language you'd use some kind of flag; for example:
found = False
for word in wordlist:
if word in ('car', 'train', 'plane'):
print "Found: " + word
found = True
if not found:
print "Nothing found."
You can implement this flag as another parameter to your clauses:
% entry point
contains(X) :- contains(X, false).
% for each word...
contains([Word|Rest], Flag) :-
Word = car -> (write('Car found.'), nl, contains(Rest, true)) ;
Word = train -> (write('Train found.'), nl, contains(Rest, true)) ;
Word = plane -> (write('Plane found.'), nl, contains(Rest, true)) ;
contains(Rest, Flag).
% end of recursion
contains([], true).
contains([], false) :- write('Nothing found.'), nl.
If you want to make distinct clause for each word (and abstract the loop), change the middle part to:
% for each word...
contains([Word|Rest], Flag) :-
checkword(Word) -> NewFlag=true ; NewFlag=Flag,
contains(Rest, NewFlag).
% and at the end:
checkword(car) :- write('Car found.'), nl.
checkword(plane) :- write('Plane found.'), nl.
checkword(train) :- write('Train found.'), nl.
Here is how I would do this:
contains(Words) :-
findall(Word,has(Words,Word),Sols),
print_result(Sols).
% Word is a target word in the list Words
has(Words,Word) :-
member(Word,Words),
member(Word,[word1,word2,word3]).
print_result([]) :- write('Nothing found.\n').
print_result([X|Xs]) :- print_sols([X|Xs]).
print_sols([]).
print_sols([X|Xs]) :-
concat(X, ' contained.\n',Output),
write(Output),
print_sols(Xs).
The advantage of this approach is that it uses a higher level of abstraction, making the predicate easier to read. Since there is just one list of target words, it also becomes easier to maintain, rather than having to add a separate clause for each new word.
The trick is with the has predicate which uses member/2 twice; once to select an item from the input list, and a second time to test that it is one of the target words. Using this as an argument to findall/3 then yields all the target words that were found in the input list.
Note: The [X|Xs] in print_results just avoids having to use a cut in the first clause.
I think that liori has the best answer. Here is a slightly different approach that might make sense in some cases, i.e.:
generate a print-out
if the print-out is empty then print "Nothing found", otherwise output the print-out
The following works in SWI-Prolog and probably not in other Prologs because it uses with_output_to/2:
% Define what are the keywords
keyword(word1).
keyword(word2).
keyword(word3).
% Define how the found keywords are pretty-printed
print_keyword(W) :-
format("Found: ~w.~n", [W]).
% Generate a print-out and output it unless its empty
print_keywords(Words) :-
with_output_to(atom(PrintOut),
forall((member(W, Words), keyword(W)), print_keyword(W))),
(
PrintOut == ''
->
writeln('Nothing found.')
;
write(PrintOut)
).