Related
The following is a common definition for len/2 which relates a list to its length, found in many introductory guides and textbooks.
% length of a list
len([], 0).
len([_H|T], L) :- len(T, M), L is M+1.
This works well for queries where the first parameter is provided as a sufficiently instantiated list, and the second parameter is an unbound variable. For example, the following asks "how long is the list [a,b,c]?"
?- len([a,b,c], L).
L=3
This query terminates, as expected.
However, in the opposite direction, we can ask "which list has length 3?". This is done by providing the first parameter as an unbound variable, and the second parameter with a value 3.
?- len(X, 3).
X = [_1688, _1694, _1700]
.. infinite loop ..
Here prolog provides the expected answer, a list containing 3 items. The 3 items are unbound variables, which is logically correct because they can take any value and the len/2 relation will still be true.
However - prolog backtracks and tries to find further solutions. This leads it to try ever longer lists, a logically infinite loop which will eventually crash a finite computer.
Question: What is the correct way to adjust the prolog program defining len/2 to avoid this non-termination?
I would like answers that explain why tactical procedural approaches, such as using cuts, is not as good as a program that applies a further logical constraint, perhaps suggesting the current program is logically correct but not complete.
UPDATE:
The following use of a cut seems to be a simple, but procedural, way to achieve the desired bi-directionality with termination.
% length of a list
len([], 0).
len([_H|T], L) :- len(T, M), L is M+1.
len2(X,Y) :- len(X,Y), !.
Test 1:
?- len2([a,b,c],L).
L =3
(terminates)
Test 2:
?- len2(X,3).
X = [_1598, _1604, _1610]
(terminates)
I'm still learning prolog so I'd appreciate, as per the original question, if and how this is logically impure. The above tests suggests it is "pure" in the sense it terminates and works bidirectionally.
I think this is a reasonable solution, to satisfy the usual requirements of:
Not spiralling off into infinity unexpectedly
Reasonable performance, elegance, determinism, readability and code-reusability
list_length(Lst, Len) :-
( nonvar(Len)
-> integer(Len),
Len #>= 0
; true
),
once_only_if(
(is_list(Lst) ; nonvar(Len)),
list_length_(Lst, 0, Len)
).
list_length_([], Len, Len).
list_length_([_|T], Upto, Len) :-
Upto1 is Upto + 1,
list_length_(T, Upto1, Len).
% Generic and reusable predicates are below
once_only_if(OnceIf, Goal) :-
call_t(OnceIf, Bool),
t_once(Bool, Goal).
call_t(Goal, Bool) :-
% Don't use *-> because Goal might contain ";" alternatives
( call(Goal)
-> Bool = true
; Bool = false
).
t_once(true, Goal) :-
call(Goal),
% Don't backtrack into Goal
!.
t_once(false, Goal) :-
call(Goal).
Results in swi-prolog:
?- list_length(L, -1).
false.
?- list_length(L, 1.5).
false.
?- list_length([a,b,c], N).
N = 3.
?- list_length(L, 3).
L = [_, _, _].
Recursion (unless TRO, tail-recursive optimization, i.e. a loop) is to be avoided unless the programmer really couldn't be bothered, because recursion is slower than non-recursion in any language (a very rare exception is permute).
Since length/2 is used so commonly in Prolog, it is performance-optimized to the extreme - swi-prolog implements it natively in C, and here's Scryer.
A better example for avoiding non-termination whilst also avoiding cuts is https://stackoverflow.com/a/74130437/
Performance comparison with:
len([], 0).
len([_H|T], Len) :-
len(T, Len0),
Len is Len0 + 1.
len2(Lst, Len) :-
len(Lst, Len), !.
?- garbage_collect, length(Lst, 5_000_000), time(list_length(Lst, Len)).
% 5,000,006 inferences, 0.096 CPU in 0.096 seconds (100% CPU, 52325193 Lips)
?- garbage_collect, length(Lst, 5_000_000), time(len2(Lst, Len)).
% 10,000,002 inferences, 2.495 CPU in 2.500 seconds (100% CPU, 4008165 Lips)
I wonder, is it possible to do planning in Prolog using the knowledge base modified by retract and assert during the runtime?
My idea is as follows: assume that I need to replace a flat tire of a car. I can either put something on the ground or move something from the ground to some free place.
So I came up with such a code:
at(flat, axle).
at(spare, trunk).
free(Where) :- at(_, Where), !, fail.
remove(What) :- at(What, _), retract(at(What, _)), assert(at(What, ground)).
put_on(What, Where) :- at(What, _), free(Where), retract(at(What, _)), assert(at(What, Where)).
(I am a rookie in Prolog so maybe that it is even wrong, if so, please advise me how to correct it.)
The idea is: I have a flat tire on the axle and a spare one in the trunk. I can remove a thing X if X is somewhere and to remove it, I remove the fact specifying where it is and add a fact that it is on the ground. Similarly, I can put a thing X to location Y if X is somewhere and Y is free and to do so, I remove X from where it is and add the fact that X is at Y.
And now I am stuck: I have no idea how to use this code now, since at(spare, axle) just says nope, even with tracing.
So the question: can such an approach be used and if so, how?
I hope it makes sense.
Using the example code from "Artificial Intelligence - Structures and Strategies for Complex Problem Solving" by George F Luger (WorldCat)
adts
%%%
%%% This is one of the example programs from the textbook:
%%%
%%% Artificial Intelligence:
%%% Structures and strategies for complex problem solving
%%%
%%% by George F. Luger and William A. Stubblefield
%%%
%%% Corrections by Christopher E. Davis (chris2d#cs.unm.edu)
%%%
%%% These programs are copyrighted by Benjamin/Cummings Publishers.
%%%
%%% We offer them for use, free of charge, for educational purposes only.
%%%
%%% Disclaimer: These programs are provided with no warranty whatsoever as to
%%% their correctness, reliability, or any other property. We have written
%%% them for specific educational purposes, and have made no effort
%%% to produce commercial quality computer programs. Please do not expect
%%% more of them then we have intended.
%%%
%%% This code has been tested with SWI-Prolog (Multi-threaded, Version 5.2.13)
%%% and appears to function as intended.
%%%%%%%%%%%%%%%%%%%% stack operations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% These predicates give a simple, list based implementation of stacks
% empty stack generates/tests an empty stack
member(X,[X|_]).
member(X,[_|T]):-member(X,T).
empty_stack([]).
% member_stack tests if an element is a member of a stack
member_stack(E, S) :- member(E, S).
% stack performs the push, pop and peek operations
% to push an element onto the stack
% ?- stack(a, [b,c,d], S).
% S = [a,b,c,d]
% To pop an element from the stack
% ?- stack(Top, Rest, [a,b,c]).
% Top = a, Rest = [b,c]
% To peek at the top element on the stack
% ?- stack(Top, _, [a,b,c]).
% Top = a
stack(E, S, [E|S]).
%%%%%%%%%%%%%%%%%%%% queue operations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% These predicates give a simple, list based implementation of
% FIFO queues
% empty queue generates/tests an empty queue
empty_queue([]).
% member_queue tests if an element is a member of a queue
member_queue(E, S) :- member(E, S).
% add_to_queue adds a new element to the back of the queue
add_to_queue(E, [], [E]).
add_to_queue(E, [H|T], [H|Tnew]) :- add_to_queue(E, T, Tnew).
% remove_from_queue removes the next element from the queue
% Note that it can also be used to examine that element
% without removing it
remove_from_queue(E, [E|T], T).
append_queue(First, Second, Concatenation) :-
append(First, Second, Concatenation).
%%%%%%%%%%%%%%%%%%%% set operations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% These predicates give a simple,
% list based implementation of sets
% empty_set tests/generates an empty set.
empty_set([]).
member_set(E, S) :- member(E, S).
% add_to_set adds a new member to a set, allowing each element
% to appear only once
add_to_set(X, S, S) :- member(X, S), !.
add_to_set(X, S, [X|S]).
remove_from_set(_, [], []).
remove_from_set(E, [E|T], T) :- !.
remove_from_set(E, [H|T], [H|T_new]) :-
remove_from_set(E, T, T_new), !.
union([], S, S).
union([H|T], S, S_new) :-
union(T, S, S2),
add_to_set(H, S2, S_new).
intersection([], _, []).
intersection([H|T], S, [H|S_new]) :-
member_set(H, S),
intersection(T, S, S_new),!.
intersection([_|T], S, S_new) :-
intersection(T, S, S_new),!.
set_diff([], _, []).
set_diff([H|T], S, T_new) :-
member_set(H, S),
set_diff(T, S, T_new),!.
set_diff([H|T], S, [H|T_new]) :-
set_diff(T, S, T_new), !.
subset([], _).
subset([H|T], S) :-
member_set(H, S),
subset(T, S).
equal_set(S1, S2) :-
subset(S1, S2), subset(S2, S1).
%%%%%%%%%%%%%%%%%%%%%%% priority queue operations %%%%%%%%%%%%%%%%%%%
% These predicates provide a simple list based implementation
% of a priority queue.
% They assume a definition of precedes for the objects being handled
empty_sort_queue([]).
member_sort_queue(E, S) :- member(E, S).
insert_sort_queue(State, [], [State]).
insert_sort_queue(State, [H | T], [State, H | T]) :-
precedes(State, H).
insert_sort_queue(State, [H|T], [H | T_new]) :-
insert_sort_queue(State, T, T_new).
remove_sort_queue(First, [First|Rest], Rest).
planner
%%%%%%%%% Simple Prolog Planner %%%%%%%%
%%%
%%% This is one of the example programs from the textbook:
%%%
%%% Artificial Intelligence:
%%% Structures and strategies for complex problem solving
%%%
%%% by George F. Luger and William A. Stubblefield
%%%
%%% Corrections by Christopher E. Davis (chris2d#cs.unm.edu)
%%%
%%% These programs are copyrighted by Benjamin/Cummings Publishers.
%%%
%%% We offer them for use, free of charge, for educational purposes only.
%%%
%%% Disclaimer: These programs are provided with no warranty whatsoever as to
%%% their correctness, reliability, or any other property. We have written
%%% them for specific educational purposes, and have made no effort
%%% to produce commercial quality computer programs. Please do not expect
%%% more of them then we have intended.
%%%
%%% This code has been tested with SWI-Prolog (Multi-threaded, Version 5.2.13)
%%% and appears to function as intended.
:- [adts].
plan(State, Goal, _, Moves) :- equal_set(State, Goal),
write('moves are'), nl,
reverse_print_stack(Moves).
plan(State, Goal, Been_list, Moves) :-
move(Name, Preconditions, Actions),
conditions_met(Preconditions, State),
change_state(State, Actions, Child_state),
not(member_state(Child_state, Been_list)),
stack(Child_state, Been_list, New_been_list),
stack(Name, Moves, New_moves),
plan(Child_state, Goal, New_been_list, New_moves),!.
change_state(S, [], S).
change_state(S, [add(P)|T], S_new) :- change_state(S, T, S2),
add_to_set(P, S2, S_new), !.
change_state(S, [del(P)|T], S_new) :- change_state(S, T, S2),
remove_from_set(P, S2, S_new), !.
conditions_met(P, S) :- subset(P, S).
member_state(S, [H|_]) :- equal_set(S, H).
member_state(S, [_|T]) :- member_state(S, T).
reverse_print_stack(S) :- empty_stack(S).
reverse_print_stack(S) :- stack(E, Rest, S),
reverse_print_stack(Rest),
write(E), nl.
/* sample moves */
move(pickup(X), [handempty, clear(X), on(X, Y)],
[del(handempty), del(clear(X)), del(on(X, Y)),
add(clear(Y)), add(holding(X))]).
move(pickup(X), [handempty, clear(X), ontable(X)],
[del(handempty), del(clear(X)), del(ontable(X)),
add(holding(X))]).
move(putdown(X), [holding(X)],
[del(holding(X)), add(ontable(X)), add(clear(X)),
add(handempty)]).
move(stack(X, Y), [holding(X), clear(Y)],
[del(holding(X)), del(clear(Y)), add(handempty), add(on(X, Y)),
add(clear(X))]).
go(S, G) :- plan(S, G, [S], []).
test :- go([handempty, ontable(b), ontable(c), on(a, b), clear(c), clear(a)],
[handempty, ontable(c), on(a,b), on(b, c), clear(a)]).
Most of the code stays the same, the only changes needed to solve your question are the predicates move/3 and the query test. Either comment out or remove the predicates move/3 and test/0 from the above code before adding predicates to solve your question.
Below is all of the new predicates needed, move/3 and test/0. The first move/3 is shown and the remainder need to be revealed (click Reveal spoiler) so that you can see them if needed but you should try to do them yourself.
move(take_from_trunk(X), [hand(empty), trunk(X)],
[del(hand(empty)), del(trunk(X)),
add(hand(X)), add(trunk(empty))]).
The state keeps track of four locations, hand, ground, axle, and trunk, and three values, flat, spare, and empty for the locations. The predicate move/3 also makes uses of variables so that they are not fixed in what they can do.
The move/3 predicate has 3 parameters.
Name: What appears in the answer, e.g. take_from_trunk(spare).
Preconditions: The conditions that have to be present in state for the move to be applied.
Actions: The changes made to state if the move is applied. These take the place of your assert and retract. The changes are very simple, you remove some of the properties of state, e.g. del(hand(empty)) and add some, e.g. add(hand(X)). For your given problem, this solution is simple in that for each change, for every del there is a matching add.
The query:
test :- go([hand(empty), trunk(spare), axle(flat), ground(empty)],
[hand(empty), trunk(flat), axle(spare), ground(empty)]).
Example run:
?- test.
moves are
take_from_trunk(spare)
place_on_ground(spare)
take_off_axle(flat)
place_in_trunk(flat)
pickup_from_ground(spare)
place_on_axle(spare)
true.
Other move/3 predicates needed. Try to do this on your own.
move(take_off_axle(X), [hand(empty), axle(X)],
[del(hand(empty)), del(axle(X)),
add(hand(X)), add(axle(empty))]).
move(place_on_ground(X), [hand(X), ground(empty)],
[del(hand(X)), del(ground(empty)),
add(hand(empty)), add(ground(X))]).
move(pickup_from_ground(X), [hand(empty), ground(X)],
[del(hand(empty)), del(ground(X)),
add(hand(X)), add(ground(empty))]).
move(place_on_axle(X), [hand(X), axle(empty)],
[del(hand(X)), del(axle(empty)),
add(hand(empty)), add(axle(X))]).
move(place_in_trunk(X), [hand(X), trunk(empty)],
[del(hand(X)), del(trunk(empty)),
add(hand(empty)), add(trunk(X))]).
In writing these predicates some of move/3 were not working as I expected so I created simple test queries for each to check them.
Using the test also helped me to change what was in state and how it was represented, e.g, instead of handempty and holding(X) it was changed to hand(empty) and hand(X) which was easier to understand, follow, and check for consistency of the code, but most likely made the code more inefficient.
test_01 :- go([hand(empty), trunk(spare), axle(flat), ground(empty)],
[hand(spare), trunk(empty), axle(flat), ground(empty)]).
test_02 :- go([hand(empty), trunk(spare), axle(flat), ground(empty)],
[hand(flat), trunk(spare), axle(empty), ground(empty)]).
test_03 :- go([hand(flat), trunk(spare), axle(empty), ground(empty)],
[hand(empty), trunk(spare), axle(empty), ground(flat)]).
test_04 :- go([hand(empty), trunk(spare), axle(empty), ground(flat)],
[hand(flat), trunk(spare), axle(empty), ground(empty)]).
test_05 :- go([hand(spare), trunk(empty), axle(empty), ground(flat)],
[hand(empty), trunk(empty), axle(spare), ground(flat)]).
test_06 :- go([hand(flat), trunk(empty), axle(spare), ground(empty)],
[hand(empty), trunk(flat), axle(spare), ground(empty)]).
Some of these test work as expected using just one move, while others return many moves. I did not modify the move/3 here so that only one move/3 is considered, but they can be modified if you so choose. Think guard statements or constraints.
The other reason the test results are listed here is to show that some of the moves are not picked in the way you would think, or intended and don't work exactly as you would expect, but yet the query to the posted question works as expected. So if you write test cases and they return something like this, don't assume your move/3 is invalid, or has bugs, they may not. When you get all of the move/3 and the final query working as expected, then go back and try to understand why these multiple moves are happening, and then modify them if you desire.
?- test_01.
moves are
take_from_trunk(spare)
true.
?- test_02.
moves are
take_from_trunk(spare)
place_on_ground(spare)
take_off_axle(flat)
place_in_trunk(flat)
pickup_from_ground(spare)
place_on_axle(spare)
take_from_trunk(flat)
place_on_ground(flat)
take_off_axle(spare)
place_in_trunk(spare)
pickup_from_ground(flat)
true.
?- test_03.
moves are
place_on_ground(flat)
true.
?- test_04.
moves are
take_from_trunk(spare)
place_on_axle(spare)
pickup_from_ground(flat)
place_in_trunk(flat)
take_off_axle(spare)
place_on_ground(spare)
take_from_trunk(flat)
place_on_axle(flat)
pickup_from_ground(spare)
place_in_trunk(spare)
take_off_axle(flat)
true.
?- test_05.
moves are
place_on_axle(spare)
true.
?- test_06.
moves are
place_on_ground(flat)
take_off_axle(spare)
place_in_trunk(spare)
pickup_from_ground(flat)
place_on_axle(flat)
take_from_trunk(spare)
place_on_ground(spare)
take_off_axle(flat)
place_in_trunk(flat)
pickup_from_ground(spare)
place_on_axle(spare)
true.
I am trying to find a sequence of steps from the starting board below to a solved state.
[[x,x,x,x,x],
[x,x,x,x,x],
[x,x,o,x,x],
[x,x,x,x,x],
[x,x,x,x,x]]
However, it takes a very long time. I have left my program running for 5 hours and have still not found a solution. Is there any way I can optimize this?
:- use_module(library(clpfd)).
rotate_clock(Xss, Zss) :-
transpose(Xss, Yss),
maplist(reverse, Yss, Zss).
rotate_anti(Xss, Zss) :-
maplist(reverse, Xss, Yss),
transpose(Yss, Zss).
linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).
horizjmp([A|T],[B|T]) :- linjmp(A,B).
horizjmp([H|T1],[H|T2]) :- horizjmp(T1,T2).
jump(B,A) :- horizjmp(B,A).
jump(B,A) :- rotate_clock(B,BR), horizjmp(BR,BRJ), rotate_anti(BRJ, A).
num_x(A, C) :- count(A, x, C).
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([H|T],X,Z):- dif(H, X), count(T,X,Z).
sum_list([], 0).
sum_list([H|T], Sum) :-
sum_list(T, Rest),
Sum is H + Rest.
solved(A) :-
maplist(num_x, A, B),
sum_list(B, C),
C == 1.
jumps([B1, B2 | []]) :-
jump(B1, B2),
solved(B2).
jumps([B1, B2 | Bs]) :-
jump(B1, B2),
jumps([B2 | Bs]).
?- jumps([[[x,x,x,x,x], [x,x,x,x,x], [x,x,o,x,x], [x,x,x,x,x], [x,x,x,x,x]]|X]), write(X), !.
Nice puzzle, 2 dimensional constraints are worth to try, even if I think, from what I read, there could be no solution...
Your code is a rather naive brute force solver. Calling transpose/2 (twice!) at every search tree node just to test a vertical pattern sounds overkill.
I'll show my attempt, starting from 'symbolic processing' (and brute force, like yours :) to model the problem.
solve_brute_force(S) :-
build(at(3,3,o),x,I),
/* uncomment to test...
I=[[x,x,x,x,x],
[x,x,x,x,x],
[x,x,o,x,x],
[x,x,x,x,x],
[x,x,x,x,x]],
*/
% try all...
% between(1,5,P),between(1,5,Q),build(at(P,Q,x),o,F),
% or just a specific pattern
build(at(2,4,x),o,F),
steps(I,F,S).
steps(F,F,[F]).
steps(A,F,[A|R]) :-
step(A,B), %show(B),
steps(B,F,R).
step(A,B) :-
append(L,[R|Rs],A),
hmove(R,U),
append(L,[U|Rs],B).
step(A,B) :-
append(L,[U0,V0,Z0|Rs],A),
vmove(U0,V0,Z0, U2,V2,Z2),
append(L,[U2,V2,Z2|Rs],B).
hmove(R,U) :-
append(Rl,[x,x,o|Rr],R),
append(Rl,[o,o,x|Rr],U).
hmove(R,U) :-
append(Rl,[o,x,x|Rr],R),
append(Rl,[x,o,o|Rr],U).
vmove(U0,V0,Z0, U2,V2,Z2) :-
nth0(C,U0,x,U1),nth0(C,V0,x,V1),nth0(C,Z0,o,Z1),!,
nth0(C,U2,o,U1),nth0(C,V2,o,V1),nth0(C,Z2,x,Z1).
vmove(U0,V0,Z0, U2,V2,Z2) :-
nth0(C,U0,o,U1),nth0(C,V0,x,V1),nth0(C,Z0,x,Z1),!,
nth0(C,U2,x,U1),nth0(C,V2,o,V1),nth0(C,Z2,o,Z1).
/*
at_least_2([R|Rs],C,S) :-
aggregate_all(count,member(S,R),T),
U is C+T,
( U >= 2 -> true ; at_least_2(Rs,U,S) ).
count(B,S,N) :-
aggregate_all(sum(Xs),
(member(R,B), aggregate_all(count, member(S,R), Xs)),
N).
*/
build(Cx,Cy,at(X,Y,A),B,P) :-
findall(Rs,(between(1,Cy,R),
findall(S,(between(1,Cx,C),
(R=Y,C=X -> S=A ; S=B)), Rs)), P).
build(A_at,B,P) :-
build(5,5,A_at,B,P).
Sorry, it doesn't terminate... but it gives us a small set of tools we can use to better understand the problem.
Did you noticed that every step there will be a peg less ?
Then, we can avoid counting pegs, and this is my better hint for optimization so far.
solve(S,R) :-
build(at(3,3,o),x,I),
steps_c(I,24,R,S).
steps_c(F,N,N,[F]).
steps_c(A,C,N,[A|R]) :-
step(A,B), % to debug... show(B),
succ(D,C), % or D is C-1,
steps_c(B,D,N,R).
Alas, it will not help too much: now we can choice the 'solution' level:
?- time(solve(S,3)),maplist([T]>>(maplist(writeln,T),nl),S).
% 155,322 inferences, 0.110 CPU in 0.111 seconds (99% CPU, 1411851 Lips)
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,o,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
[o,o,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
...
Let's evaluate some solutions with 3 poles left:
?- time(call_nth(solve(S,3),1000)).
% 4,826,178 inferences, 2.913 CPU in 2.914 seconds (100% CPU, 1656701 Lips)
S = [[[x, x, x, x, x], ....
?- time(call_nth(solve(S,3),10000)).
% 53,375,354 inferences, 31.968 CPU in 31.980 seconds (100% CPU, 1669646 Lips)
S = [[[x, x, x, x, x],
We have about 5K inferences / solution at level 3. But it's clear there are a lot of them. So, it's hopeless to attempt ?- solve(S, 1). This brute force approach doesn't work...
Maybe I will try using better problem domain encoding, and modelling with library(clpfd).
Here comes Project Euler Problem 303, "Multiples with small digits".
For a positive integer n, define f(n) as the least positive multiple of n that, written in base 10, uses only digits ≤ 2.
Thus f(2)=2, f(3)=12, f(7)=21, f(42)=210, f(89)=1121222.
Also, .
Find .
This is the code I have already written / that I want to improve:
:- use_module(library(clpfd)).
n_fn(N,FN) :-
F #> 0,
FN #= F*N,
length(Ds, _),
digits_number(Ds, FN),
Ds ins 0..2,
labeling([min(FN)], Ds).
That code already works for solving a small number of small problem instances:
?- n_fn(2,X).
X = 2
?- n_fn(3,X).
X = 12
?- n_fn(7,X).
X = 21
?- n_fn(42,X).
X = 210
?- n_fn(89,X).
X = 1121222
What can I do to tackle above challenge "find: sum(n=1 to 10000)(f(n)/n)"?
How can I solve more and bigger instances in reasonable time?
Please share your ideas with me! Thank you in advance!
It is slow on 9's and there is a pattern..
so..
n_fn(9,12222):-!.
n_fn(99,1122222222):-!.
n_fn(999,111222222222222):-!.
n_fn(9999,11112222222222222222):-!.
But i'm sure it would be nicer to have the prolog find this patten and adapt the search.. not sure how you would do that though!
In general it must be recalculating a lot of results..
I cannot spot a recurrence relation for this problem. So, initially I was thinking that memoizing could speed it up. Not really...
This code, clp(fd) based, is marginally faster than your...
n_fn_d(N,FN) :-
F #> 0,
FN #= F*N,
digits_number_d([D|Ds], Ts),
D in 1..2,
Ds ins 0..2,
scalar_product(Ts, [D|Ds], #=, FN),
labeling([min(FN)], [D|Ds]).
digits_number_d([_], [1]).
digits_number_d([_|Ds], [T,H|Ts]) :-
digits_number_d(Ds, [H|Ts]), T #= H*10.
When I used clp(fd) to solve problems from Euler, I stumbled in poor performance... sometime the simpler 'generate and test' paired with native arithmetic make a difference.
This simpler one, 'native' based:
n_fn_e(N,FN) :-
digits_e(FN),
0 =:= FN mod N.
digits_e(N) :-
length([X|Xs], _),
maplist(code_e, [X|Xs]), X \= 0'0,
number_codes(N, [X|Xs]).
code_e(0'0).
code_e(0'1).
code_e(0'2).
it's way faster:
test(N) :-
time(n_fn(N,A)),
time(n_fn_d(N,B)),
time(n_fn_e(N,C)),
writeln([A,B,C]).
?- test(999).
% 473,671,146 inferences, 175.006 CPU in 182.242 seconds (96% CPU, 2706593 Lips)
% 473,405,175 inferences, 173.842 CPU in 178.071 seconds (98% CPU, 2723188 Lips)
% 58,724,230 inferences, 25.749 CPU in 26.039 seconds (99% CPU, 2280636 Lips)
[111222222222222,111222222222222,111222222222222]
true
I am trying to understand the use of DCGs better. In order to do this, I tried to translate some exercises in the LearnPrologNow book to DCG notation. However, I am failing miserably.
What I tried to write a program that simply names the last element in a list. That's all. I just can't think of the right DCG syntax to do this. I think I figured out the 'base case' which should be:
last --> [X|[]].
Where X is the last element. How do I make Prolog go down the list recursively? Or am I thinking about DCGs in a wrong way?
... --> [] | [_], ... .
list_last(Xs, X) :-
phrase((...,[X]), Xs).
This is clearly the most "graphical" definition. You can describe a lot of patterns with ... //0.
Grammars are a way to describe a language. So your question about how to make Prolog go down is malposed. Grammars don't do anything. They if you insist "generate" sentences.
For the procedural details, you need to understand termination, but no more than that.
Edit: And if you really care about performance, then measure it first. With SWI, I obtain the following. Note the usage of an extra library to remove the calling overheads for phrase/2.
?- use_module(library(apply_macros)).
% library(pairs) compiled into pairs 0.00 sec, 22 clauses
% library(lists) compiled into lists 0.01 sec, 122 clauses
% library(occurs) compiled into occurs 0.00 sec, 14 clauses
% library(apply_macros) compiled into apply_macros 0.01 sec, 168 clauses
true.
?- [user].
**omitted**
?- listing.
dcg_last(B, A) :-
last(A, B, []).
list_last(A, C) :-
...(A, B),
B=[C].
...(A, B) :-
( A=B
; A=[_|C],
...(C, B)
).
last(A, [_|B], C) :-
last(A, B, C).
last(A, [A|B], B).
:- thread_local thread_message_hook/3.
:- dynamic thread_message_hook/3.
:- volatile thread_message_hook/3.
true.
?- length(L,100000), time(list_last(L,E)).
% 100,000 inferences, 0.018 CPU in 0.030 seconds (60% CPU, 5482960 Lips)
L = [_G351, _G354, _G357, _G360, _G363, _G366, _G369, _G372, _G375|...] ;
% 5 inferences, 0.000 CPU in 0.000 seconds (94% CPU, 294066 Lips)
false.
?- length(L,100000), time(dcg_last(L,E)).
% 100,001 inferences, 0.033 CPU in 0.057 seconds (58% CPU, 3061609 Lips)
L = [_G19, _G22, _G25, _G28, _G31, _G34, _G37, _G40, _G43|...] ;
% 2 inferences, 0.011 CPU in 0.023 seconds (49% CPU, 175 Lips)
false.
So both are performing roughly the same number of inferences, but dcg_last/2 is slower, since it has to pile up all those useless choicepoints. list_last/2 creates the same number of choice-points, however, they are almost immediately removed. So we have 0.018s vs. 0.033s+0.011s.
You are missing the recursive step, and making the base clause more complex than needed.
dcg_last(List, E) :-
phrase(last(E), List).
last(E) --> [_], last(E).
last(E) --> [E].
last//1 just skips any element, until to last. The key, however, is how phrase/2 translates productions. phrase(last(E), List) is equivalent to phrase(last(E), List, []), that is, the grammar must consume all input.
This isn't an answer! CapelliC explains it. It's just the comments are useless for formatted code, and this comment belongs below his answer :
If you use the 'listing.' predicate on his answer after consulting it, this is what prolog has rewritten it to, and will execute :
last(A, [_|B], C) :-
last(A, B, C).
last(A, [A|B], B).
dcg_last(B, A) :-
phrase(last(A), B).
So DCGs are just syntactic sugar on top of regular prolog expressions - a recursive loop as explained - you have to go through the list ('consume all input') to reach the end.