I prepared a Prolog solution of a riddle about people living in a three-floor block with two sides(left,right) - so 6 flats. The solution is correct. The code for solution is below:
What I want to achieve is to have three different predicates answer1/1, answer2/2, answer3/3 where:
Answer1/1 - returns information about all people, I think that clues(Left,Right) already does that, however I think that /1 means the number of arguments in predicate. Is it possible to make it with just one argument?
Answer2/2 - returns information about person with certain attribute, let's say it's supposed to show citizen with first attribute equal to 'wladyslaw'.
Answer3/3 - returns information about people from the left side of building (so those, who are mentioned in parameter Left in Answer1/1.
I wonder, whether this slash and value means number of parameters and if so - is it possible to make it? Thanks in advance.
There's 2 variables for each person - their floor (numbered 1-3, with 3 being ground), and their block (left or right, i.e. 1 or 2).
Your clue1, clue2 etc. are kinda cheating because they are specifying the floor and block of the persons.
Here is not-completely-tested code, with lots of clues:
% Like nth1, but for multiple lists
% LN is list number, starting at 1
nth1_lists(N, [H|T], E, LN) :-
nth1_lists_(T, H, N, E, 1, LN).
nth1_lists_(_, H, N, E, LN, LN) :-
nth1(N, H, E).
nth1_lists_([H|T], _, N, E, LN0, LN) :-
LN1 is LN0 + 1,
nth1_lists_(T, H, N, E, LN1, LN).
% Changes to plural - presumably don't care which block
in_blocks(P, Blocks) :-
% Don't care which pos or block
nth1_lists(_, Blocks, P, _).
lives_above(X, Y, Blocks) :-
% Same block B
nth1_lists(XN, Blocks, X, B),
nth1_lists(YN, Blocks, Y, B),
XN < YN.
lives_near(X, Y, Blocks) :-
% Different block, same pos
dif(XB, YB),
nth1_lists(Pos, Blocks, X, XB),
nth1_lists(Pos, Blocks, Y, YB).
lives_1_floor_above(X, Y, Blocks) :-
% Pos 1 is highest, pos 3 is ground floor
nth1_lists(XN, Blocks, X, _),
nth1_lists(YN, Blocks, Y, _),
YN is XN + 1.
lives_between(X, Y, Z, Blocks) :-
dif(C, =),
% Same block
nth1_lists(XN, Blocks, X, B),
nth1_lists(YN, Blocks, Y, B),
nth1_lists(ZN, Blocks, Z, B),
% Same comparison sign
compare(C, XN, YN),
compare(C, YN, ZN).
% Removed person Y - only care about person X
on_left(X, Blocks) :-
% Left block is block 1
nth1_lists(_, Blocks, X, 1).
ground_floor(X, Blocks) :-
% Don't care which block
nth1(3, Blocks, X, _).
clues(Blocks) :-
% Size of blocks
length(Blocks, 2),
maplist(length(3), Blocks),
% Or just use: Blocks = [[_,_,_], [_,_,_]],
% clue1
lives_above(karmikanarki, wkazdejchwili, Blocks),
% clue2
lives_near(weronika, o4rano, Blocks),
lives_near(zamiatachodniki, wladyslaw, Blocks).
% and so on, up to clue 13
answer1(Blocks) :-
clues(Blocks).
answer2(Person, Pos-Block) :-
clues(Blocks),
nth1_lists(Pos, Blocks, Person, Block).
% Unsure whether Block is desired in arguments
answer3(Person, Pos-Block) :-
clues(Blocks),
% Person is in block 1
on_left(Person, Blocks),
nth1_lists(Pos, Blocks, Person, Block).
Answer1/1 - returns information about all people, I think that clues(Left,Right) already does that, however I think that /1 means the number of arguments in predicate. Is it possible to make it with just one argument?
Yes the /1 does mean the number of arguments (it's called the 'arity'). Change clues(Left,Right) :- to clues(Left-Right) :- and it is one argument. Just change that header and the way you query it, nothing else.
Answer2/2 - returns information about person with certain attribute, let's say it's supposed to show citizen with first attribute equal to 'wladyslaw'.
Your comment to #brebs says you cannot use lists, so you cannot use member/2. Here is a way:
answer2(Name, Citizen) :-
clues(left(L1, L2, L3)-right(R1, R2, R3)),
( (L1 = citizen(Name, _, _), Citizen = L1)
; (L2 = citizen(Name, _, _), Citizen = L2)
; (L3 = citizen(Name, _, _), Citizen = L3)
; (R1 = citizen(Name, _, _), Citizen = R1)
; (R2 = citizen(Name, _, _), Citizen = R2)
; (R3 = citizen(Name, _, _), Citizen = R3)).
Answer3/3 - returns information about people from the left side of building (so those, who are mentioned in parameter Left in Answer1/1.
answer3(L1, L2, L3) :-
clues(left(L1, L2, L3)-_).
Related
I want to count a specific element in a list.
?count(3,[3,3,3],C).
count(_,[],_).
count(X,[Y|R],C):- X \= Y, count(X,R,C).
count(X,[Y|R],C):- X = Y, L is C + 1, count(X,R,L).
But I get this error and I do not see why:
Arguments are not sufficiently instantiated
In:
[1] count(3,[3,3|...],_1594)
Do you have a tipp?
The instantiation error occurs in the goal L is C + 1 as the variable C is unbound when the goal is called.
One solution is to rewrite the predicate to use an accumulator. Doing the minimal changes to your code:
count(Element, List, Count) :-
count(Element, List, 0, Count).
count(_, [], Count, Count).
count(X, [Y|R], Count0, Count) :-
X \= Y,
count(X, R, Count0, Count).
count(X, [Y|R], Count0, Count) :-
X = Y,
Count1 is Count0 + 1,
count(X, R, Count1, Count).
With your sample call:
| ?- count(3, [3,3,3], Count).
Count = 3 ? ;
no
Notice that this new definition leaves a spurious choice-point. Can you improve it so that calls (with the two first arguments ground) become deterministic? Hint: start by moving the list argument to the first position in the auxiliary count/4 predicate.
I've been searching for something that might help me with my problem all over the internet but I haven't been able to make any progress. I'm new to logic programming and English is not my first language so apologize for any mistake.
Basically I want to implement this prolog program: discord/3 which has arguments L1, L2 lists and P where P are the indexes of the lists where L1[P] != L2[P] (in Java). In case of different lengths, the not paired indexes just fail. Mode is (+,+,-) nondet.
I got down the basic case but I can't seem to wrap my head around on how to define P in the recursive call.
discord(_X,[],_Y) :-
fail.
discord([H1|T1],[H1|T2],Y) :-
???
discord(T1,T2,Z).
discord([_|T1],[_|T2],Y) :-
???
discord(T1,T2,Z).
The two clauses above are what I came up to but I have no idea on how to represent Y - and Z - so that the function actually remembers the length of the original list. I've been thinking about using nth/3 with eventually an assert but I'm not sure where to place them in the program.
I'm sure there has to be an easier solution although. Thanks in advance!
You can approach this in two ways. First, the more declarative way would be to enumerate the indexed elements of both lists with nth1/3 and use dif/2 to ensure that the two elements are different:
?- L1 = [a,b,c,d],
L2 = [x,b,y,d],
dif(X, Y),
nth1(P, L1, X),
nth1(P, L2, Y).
X = a, Y = x, P = 1 ;
X = c, Y = y, P = 3 ;
false.
You could also attempt to go through both list at the same time and keep a counter:
discord(L1, L2, P) :-
discord(L1, L2, 1, P).
discord([X|_], [Y|_], P, P) :-
dif(X, Y).
discord([_|Xs], [_|Ys], N, P) :-
succ(N, N1),
discord(Xs, Ys, N1, P).
Then, from the top level:
?- discord([a,b,c,d], [a,x,c,y], Ps).
Ps = 2 ;
Ps = 4 ;
false.
I'm trying to sort a 10k element list in prolog with bubblesort and I get the out of local stack error. Mergesort seems to be the best option since I don't get any errors for the same input. However I'd really like to get some running times for bubblesort with large input data but I can't. Any ideas?
Here's the code:
%% NOTE: SWI-PROLOG USED
%% generate_list(Limit, N, L): - insert upper limit and length of list N
%% to get a random list with N numbers from 0 to limit
generate_list(_, 0, []).
generate_list(Limit, N, [Y|L]):-
N =\= 0,
random(0, Limit, Y),
N1 is N-1,
generate_list(Limit, N1, L).
%% bubble(L, Ls, max):- insert list L and get max member of list by
%% swapping members from the start of L.
bubble([Z], [], Z).
bubble([X,Y|L], [X|Ls], Z):- X =< Y, bubble([Y|L], Ls, Z).
bubble([X,Y|L], [Y|Ls], Z):- X > Y, bubble([X|L], Ls, Z).
%% bubble_sort(List, Accumulator, Sorted_List)
bubblesort([X], Ls, [X|Ls]).
bubblesort(L, Accumulate, Result):- bubble(L, Ls, Max),
bubblesort(Ls, [Max|Accumulate], Result).
bubble_sort(L, Sorted):- bubblesort(L, [], Sorted).
As you can I see I'm using tail recursion. I've also tried enlarging the stacks by using:
set_prolog_stack(global, limit(100 000 000 000)).
set_prolog_stack(trail, limit(20 000 000 000)).
set_prolog_stack(local, limit(2 000 000 000)).
but it just runs for a bit longer. Eventually I get out of local stack again.
Should I use another language like C and malloc the list or not use recursion?
Since there are two answers, and no one pointed out explicitly enough the reason why you get into "out of local stack" trouble (Mat says in the comment to your question that your predicates are not deterministic, but does not explain exactly why).
Two of the predicates you have defined, namely, bubblesort/3 and bubble/3, have mutually exclusive clauses. But Prolog (at least SWI-Prolog) does not recognize that these are mutually exclusive. So, choice points are created, you don't get tail recursion optimization, and probably no garbage collection (you need to measure using your implementation of choice if you want to know how much goes where and when).
You have two different problems.
Problem 1: lists with exactly one element
This problem pops up in both predicates. In the most simple predicate possible:
foo([_]).
foo([_|T]) :-
foo(T).
And then:
?- foo([a]).
true ;
false.
This is not surprising; consider:
?- [a] = [a|[]].
true.
You can solve this by using a technique called lagging:
bar([H|T]) :-
bar_1(T, H).
bar_1([], _).
bar_1([H|T], _) :-
bar_1(T, H).
Then:
?- bar([a]).
true.
In the definition of bar_1/2, the first argument to the first clause is the empty list; the first argument to the second clause is a non-empty list (a list with at least one element, and a tail). Prolog does not create choice points when all clauses are obviously exclusive. What obvious means will depend on the implementation, but usually, when the first arguments to all clauses are all terms with different functors, then no choice points are created.
Try the following (you might get different results, but the message is the same):
?- functor([], Name, Arity).
Name = [],
Arity = 0.
?- functor([_|_], Name, Arity).
Name = '[|]',
Arity = 2.
See this question and the answer by Mat to see how you can use this to make your program deterministic.
Mat, in his answer, uses this approach, if I see correctly.
Problem 2: constraints (conditions) in the body of the clauses
This is the problem with the second and third clause of bubble/3. In the textbook "correct" example of choosing the minimum of two elements:
min(A, B, B) :- B #< A.
min(A, B, A) :- A #=< B.
Then:
?- min(1,2,1).
true.
but:
?- min(2,1,1).
true ;
false.
You can solve this in two ways: either by doing what Mat is doing, which is, using compare/3, which succeeds deterministically; or, by doing what CapelliC is doing, which is, using an if-then-else.
Mat:
min_m(A, B, Min) :-
compare(Order, A, B),
min_order(Order, A, B, Min).
min_order(<, A, _, A).
min_order(=, A, _, A).
min_order(>, _, B, B).
And Carlo:
min_c(A, B, Min) :-
( B #< A
-> Min = B
; Min = A
).
I know there will always be at least as many opinions as heads, but both are fine, depending on what you are doing.
PS
You could use the built in length/2 to generate a list, and re-write your generate_list/3 like this:
generate_list(Limit, Len, List) :-
length(List, Len),
random_pos_ints(List, Limit).
random_pos_ints([], _).
random_pos_ints([H|T], Limit) :-
random(0, Limit, H),
random_pos_ints(T, Limit).
The helper random_pos_ints/2 is a trivial predicate that can be expressed in terms of maplist:
generate_list(Limit, Len, List) :-
length(List, Len),
maplist(random(0, Limit), List).
Here is a version of bubble/3 that is deterministic if the first argument is instantiated, so that tail call optimisation (and, more specifically, tail recursion optimisation) applies:
bubble([L|Ls0], Ls, Max) :- phrase(bubble_(Ls0, L, Max), Ls).
bubble_([], Max, Max) --> [].
bubble_([L0|Ls0], Max0, Max) -->
elements_max(L0, Max0, Max1),
bubble_(Ls0, Max1, Max).
elements_max(X, Y, Max) -->
{ compare(C, X, Y) },
c_max(C, X, Y, Max).
c_max(<, X, Y, Y) --> [X].
c_max(=, X, Y, Y) --> [X].
c_max(>, X, Y, X) --> [Y].
Example usage, with the rest of the program unchanged (running times depend on the random list, which is bad if you want to reproduce these results - hint: introduce the random seed as argument to fix this):
?- generate_list(100, 10_000, Ls), time(bubble_sort(Ls, Ls1)).
% 200,099,991 inferences, 29.769 CPU in 34.471 seconds
...
For testing different versions, please use a version of the query that you can use to reliably reproduce the same initial list, such as:
?- numlist(1, 10_000, Ls0), time(bubble_sort(Ls0, Ls)).
The nice thing is: If you just use zcompare/3 from library(clpfd) instead of compare/3, you obtain a version that can be used in all directions:
?- bubble(Ls0, Ls, Max).
Ls0 = [Max],
Ls = [] ;
Ls0 = [Max, _G677],
Ls = [_G677],
_G677#=<Max+ -1,
zcompare(<, _G677, Max) ;
Ls0 = [Max, _G949, _G952],
Ls = [_G949, _G952],
_G952#=<Max+ -1,
_G949#=<Max+ -1,
zcompare(<, _G952, Max),
zcompare(<, _G949, Max) ;
etc.
This describes the relation in general terms between integers.
Disclaimer: following the hint by #mat could be more rewarding...
I've played a bit with your code, in my experiment the local stack overflow was thrown with a list length near 2500. Then I've placed some cut:
%% bubble(L, Ls, max):- insert list L and get max member of list by
%% swapping members from the start of L.
bubble([Z], [], Z).
bubble([X,Y|L], [R|Ls], Z):-
( X =< Y -> (R,T)=(X,Y) ; (R,T)=(Y,X) ),
bubble([T|L], Ls, Z).
%% bubble_sort(List, Accumulator, Sorted_List)
bubblesort([X], Ls, [X|Ls]) :- !.
bubblesort(L, Accumulate, Result):-
bubble(L, Ls, Max),
!, bubblesort(Ls, [Max|Accumulate], Result).
and I get
?- time(generate_list(100,10000,L)),time(bubble_sort(L,S)).
% 60,000 inferences, 0.037 CPU in 0.037 seconds (99% CPU, 1618231 Lips)
% 174,710,407 inferences, 85.707 CPU in 86.016 seconds (100% CPU, 2038460 Lips)
L = [98, 19, 80, 24, 16, 59, 70, 39, 22|...],
S = [0, 0, 0, 0, 0, 0, 0, 0, 0|...]
.
so, it's working, but very slowly, showing the quadratic complexity...
How to define in ISO Prolog a (meta-logical) predicate for the intersection of two lists of variables that runs in linear time? The variables may appear in any determined order. No implementation dependent property like the "age" of variables must influence the outcome.
In analogy to library(ordsets), let's call the relation varset_intersection(As, Bs, As_cap_Bs).
?- varset_intersection([A,B], [C,D], []).
true.
?-varset_intersection([A,B], [B,A], []).
false.
?- varset_intersection([A,B,C], [C,A,D], Inter).
Inter = [A,C].
or
Inter = [C,A].
?- varset_intersection([A,B],[A,B],[A,C]).
B = C
or
A = B, A = C
?- varset_intersection([A,B,C],[A,B],[A,C]).
idem
That is, the third argument is an output argument, that unifies with the intersection of the first two arguments.
See this list of the built-ins from the current ISO standard (ISO/IEC 13211-1:1995 including Cor.2).
(Note, that I did answer this question in the course of another one several years ago. However, it remains hidden and invisible to Google.)
If term_variables/2 works in a time linear with the size of its first argument, then this might work:
varset_intersection(As, Bs, As_cap_Bs):-
term_variables([As, Bs], As_and_Bs),
term_variables(As, SetAs),
append(SetAs, OnlyBs, As_and_Bs),
term_variables([OnlyBs, Bs], SetBs),
append(OnlyBs, As_cap_Bs, SetBs).
Each common variable appears only once in the result list no matter how many times it appears in the two given lists.
?- varset_intersection2([A,_C,A,A,A], [A,_B,A,A,A], L).
L = [A].
Also, it might give strange results as in this case:
?- varset_intersection([A,_X,B,C], [B,C,_Y,A], [C, A, B]).
A = B, B = C.
(permutation/2 might help here).
If copy_term/2 uses linear time, I believe the following works:
varset_intersection(As, Bs, Cs) :-
copy_term(As-Bs, CopyAs-CopyBs),
ground_list(CopyAs),
select_grounded(CopyBs, Bs, Cs).
ground_list([]).
ground_list([a|Xs]) :-
ground_list(Xs).
select_grounded([], [], []).
select_grounded([X|Xs], [_|Bs], Cs) :-
var(X),
!,
select_grounded(Xs, Bs, Cs).
select_grounded([_|Xs], [B|Bs], [B|Cs]) :-
select_grounded(Xs, Bs, Cs).
The idea is to copy both lists in one call to copy_term/2 to preserve shared variables between them, then ground the variables of the first copy, then pick out the original variables of the second list corresponding to the grounded positions of the second copy.
If unify_with_occurs_check(Var, ListOfVars) fails or succeeds in constant time, this implementation should yield answers in linear time:
filter_vars([], _, Acc, Acc).
filter_vars([A|As], Bs, Acc, As_cap_Bs):-
(
\+ unify_with_occurs_check(A, Bs)
->
filter_vars(As, Bs, [A|Acc], As_cap_Bs)
;
filter_vars(As, Bs, Acc, As_cap_Bs)
).
varset_intersection(As, Bs, As_cap_Bs):-
filter_vars(As, Bs, [], Inter),
permutation(Inter, As_cap_Bs).
This implementation has problems when given lists contain duplicates:
?- varset_intersection1([A,A,A,A,B], [B,A], L).
L = [B, A, A, A, A] ;
?- varset_intersection1([B,A], [A,A,A,A,B], L).
L = [A, B] ;
Edited : changed bagof/3 to a manually written filter thanks to observation by #false in comments below.
A possible solution is to use a Bloom filter. In case of collision, the result might be wrong, but functions with better collision resistance exist. Here is an implementation that uses a single hash function.
sum_codes([], _, Sum, Sum).
sum_codes([Head|Tail], K, Acc,Sum):-
Acc1 is Head * (256 ** K) + Acc,
K1 is (K + 1) mod 4,
sum_codes(Tail, K1, Acc1, Sum).
hash_func(Var, HashValue):-
with_output_to(atom(A), write(Var)),
atom_codes(A, Codes),
sum_codes(Codes, 0, 0, Sum),
HashValue is Sum mod 1024.
add_to_bitarray(Var, BAIn, BAOut):-
hash_func(Var, HashValue),
BAOut is BAIn \/ (1 << HashValue).
bitarray_contains(BA, Var):-
hash_func(Var, HashValue),
R is BA /\ (1 << HashValue),
R > 0.
varset_intersection(As, Bs, As_cap_Bs):-
foldl(add_to_bitarray, As, 0, BA),
include(bitarray_contains(BA), Bs, As_cap_Bs).
I know that foldl/4 and include/3 are not ISO, but their implementation is easy.
I have a list of lists, which looks something like this:
[[b,c],[],[a]]
I want to write a predicate that will take a specific letter from the top of one of the lists, and put it in another list. The letter to be moved is specified beforehand. It can be placed on top of a list which is either empty, or contains a letter that is larger (b can be placed on c, but not otherwise). The letter should be removed from the original list after it has been moved.
I am having trouble telling Prolog to look for a list which starts with the specified letter, and also how to tell Prolog to put this in another list.
here is my solution, based no [nth1][1]/4 (well, you should read documentation for nth0/4, really)
/* takes a specific letter from the top of one of the lists, and puts it in another list.
The letter to be moved is specified beforehand.
It can be placed on top of a list which is either empty, or contains a letter that is larger (b can be placed on c, but not otherwise).
The letter should be removed from the original list after it has been moved.
*/
move_letter(Letter, Lists, Result) :-
% search Letter, Temp0 miss amended list [Letter|Rest]
nth1(I, Lists, [Letter|Rest], Temp0),
% reinsert Rest, Temp1 just miss Letter
nth1(I, Temp1, Rest, Temp0),
% search an appropriate place to insert Letter
nth1(J, Temp1, Candidate, Temp2),
% insertion constraints
J \= I, (Candidate = [] ; Candidate = [C|_], C #> Letter),
% update Result
nth1(J, Result, [Letter|Candidate], Temp2).
Usage examples:
?- move_letter(a,[[b,c],[],[a]],R).
R = [[a, b, c], [], []] ;
R = [[b, c], [a], []] ;
false.
?- move_letter(b,[[b,c],[],[a]],R).
R = [[c], [b], [a]] ;
false.
I followed this 'not idiomatic' route to ease the check that the insertion occurs at different place than deletion.
Below are some rules to find lists that starts with some element.
starts_with([H|T], H).
find_starts_with([],C,[]).
find_starts_with([H|T],C,[H|Y]) :- starts_with(H,C),find_starts_with(T,C,Y).
find_starts_with([H|T],C,L) :- \+ starts_with(H,C), find_starts_with(T,C,L).
Example:
| ?- find_starts_with([[1,2],[3,4],[1,5]],1,X).
X = [[1,2],[1,5]] ? ;
I like #CapelliC's concise solution. Here's an alternative solution that doesn't use the nth1 built-in. Apologies for the sucky variable names.
% move_letter : Result is L with the letter C removed from the beginning
% of one sublist and re-inserted at the beginning of another sublist
% such that the new letter is less than the original beginning letter
% of that sublist
%
move_letter(C, L, Result) :-
removed_letter(C, L, R, N), % Find & remove letter from a sublist
insert_letter(C, R, 0, N, Result). % Result is R with the letter inserted
% removed_letter : R is L with the letter C removed from the beginning of a
% sublist. The value N is the position within L that the sublist occurs
%
removed_letter(C, L, R, N) :-
removed_letter(C, L, R, 0, N).
removed_letter(C, [[C|T]|TT], [T|TT], A, A).
removed_letter(C, [L|TT], [L|TTR], A, N) :-
A1 is A + 1,
removed_letter(C, TT, TTR, A1, N).
% Insert letter in empty sublist if it's not where the letter came from;
% Insert letter at front of a sublist if it's not where the letter came from
% and the new letter is less than the current head letter;
% Or insert letter someplace later in the list of sublists
%
insert_letter(C, [[]|TT], A, N, [[C]|TT]) :-
A \== N.
insert_letter(C, [[C1|T]|TT], A, N, [[C,C1|T]|TT]) :-
A \== N,
C #< C1.
insert_letter(C, [L|TT], A, N, [L|TTR]) :-
A1 is A + 1,
insert_letter(C, TT, A1, N, TTR).
Results in:
| ?- move_letter(a, [[b,c],[],[a]], R).
R = [[a,b,c],[],[]] ? a
R = [[b,c],[a],[]]
no
| ?- move_letter(b, [[b,c],[],[a]], R).
R = [[c],[b],[a]] ? a
no
| ?- move_letter(b, [[b,c], [], [a], [b,d]], R).
R = [[c],[b],[a],[b,d]] ? a
R = [[b,c],[b],[a],[d]]
no