Related
We want to count the correspondences between two (possibly long) strings which happen to represent DNA sequences. The sequences are lists-of-chars where the char is taken from a,c,t,g,'_', with the '_' a "don't know" placeholder which never corresponds to anything, even itself. In this case, we employ library(aggregate) (thanks to CapelliC for the idea):
match(Seq1,Seq2,Count) :-
aggregate_all(count,
(
nth1(Pos,Seq1,X),
nth1(Pos,Seq2,X),
memberchk(X,[a,c,g,t])
),
N).
This approach can be compared to a "straightforward" approach where one would set up a (tail-recursive) recursion that just walks down both sequences in tandem and compares elements pairwise, counting as it goes.
As the sequences can be very large, algorithmic complexity becomes of some interest.
One would expect, with n = length(sequence) and both sequences the same length:
Straightforward approach: complexity is O(n)
aggregation approach: complexity is O(n²)
What is the (time and maybe space) complexity of the above algorithm and why?
Test code
To complement the above, an SWI-Prolog based plunit test code block:
:- begin_tests(atcg).
wrap_match(String1,String2,Count) :-
atom_chars(String1,Seq1),
atom_chars(String2,Seq2),
fit(Seq1,Seq1,0,Count).
test("string 1 empty",nondet) :-
wrap_match("atcg","",Count),
assertion(Count == 0).
test("string 2 empty") :-
wrap_match("","atcg",Count),
assertion(Count == 0).
test("both strings empty") :-
wrap_match("","",Count),
assertion(Count == 0).
test("both strings match, 1 char only") :-
wrap_match("a","a",Count),
assertion(Count == 1).
test("both strings match") :-
wrap_match("atcgatcgatcg","atcgatcgatcg",Count),
assertion(MatchCount == 12).
test("both strings match with underscores") :-
wrap_match("_TC_ATCG_TCG","_TC_ATCG_TCG",Count),
assertion(MatchCount == 9).
test("various mismatches 1") :-
wrap_match("atcgatcgatcg","atcgatcgatcg",Count),
assertion(MatchCount == 8).
test("various mismatches with underscores") :-
wrap_match("at_ga_cg__cg","atcgatcgatcg",Count),
assertion(Count == 8).
:- end_tests(atcg).
And so:
?- run_tests.
% PL-Unit: atcg ........ done
% All 8 tests passed
true.
Empirical info
After some manual data collection (something that cries out for automatization) using the code below, which outputs time elapsed and number of inferences made to the console:
gimme_random_sequence(Length,Seq) :-
length(Seq,Length),
maplist(
[E]>>(random_between(0,3,Ix),nth0(Ix,[a,t,c,g],E)),
Seq).
how_fast(Length) :-
gimme_random_sequence(Length,Seq1),
gimme_random_sequence(Length,Seq2),
time(match(Seq1,Seq2,_)).
... and a bit of graph fumbling in LibreOffice Calc (my ggplot skills are rusty), we have empirical data that this algorithm's cost is
O((length(sequence))²).
Count,Inferences,Seconds,milliseconds,megainferences
1000,171179,0.039,39,0.171179
2000,675661,0.097,97,0.675661
3000,1513436,0.186,186,1.513436
4000,2684639,0.327,327,2.684639
5000,4189172,0.502,502,4.189172
6000,6027056,0.722,722,6.027056
7000,8198103,1.002,1002,8.198103
8000,10702603,1.304,1304,10.702603
9000,13540531,1.677,1677,13.540531
10000,16711607,2.062,2062,16.711607
11000,20216119,2.449,2449,20.216119
20000,66756619,8.091,8091,66.756619
30000,150134731,17.907,17907,150.134731
40000,266846773,32.012,32012,266.846773
50000,416891749,52.942,52942,416.891749
60000,600269907,74.103,74103,600.269907
Never ever use functional programming idioms in Prolog that avoid backtracking, like maplist/4. This here, pair_member/4 and match3/3, should be a tick faster.
match2(Seq1, Seq2, Count) :-
( maplist([X,Y,X-Y]>>true, Seq1, Seq2, Seq3)
-> aggregate_all(count, (member(X-X, Seq3), X\='_'), Count)
; Count = 0 ).
pair_member(X, Y, [X|_], [Y|_]).
pair_member(X, Y, [_|L], [_|R]) :-
pair_member(X, Y, L, R).
match3(Seq1, Seq2, Count) :-
aggregate_all(count,
(pair_member(X, X, Seq1, Seq2), X \= '_'), Count).
gimme_random_sequence(Length, Seq) :-
length(Seq, Length),
maplist([E]>>(random_between(0,3,Ix), nth0(Ix, [a,t,c,g], E)), Seq).
test(N) :-
gimme_random_sequence(N, S1),
gimme_random_sequence(N, S2),
time(match2(S1, S2, Count)),
time(match3(S1, S2, Count)).
Woa! Its 10x times faster! Thanks to genius of SWI-Prolog how it
compiles the tail recursion in pair_member/4:
/* SWI-Prolog 8.3.21, MacBook Air 2019 */
?- set_prolog_flag(double_quotes, chars).
true.
?- X = "abc".
X = [a, b, c].
?- match2("_TC_ATCG_TCG","_TC_ATCG_TCG",Count).
Count = 9.
?- match3("_TC_ATCG_TCG","_TC_ATCG_TCG",Count).
Count = 9.
?- test(100000).
% 1,575,520 inferences, 0.186 CPU in 0.190 seconds (98% CPU, 8465031 Lips)
% 175,519 inferences, 0.018 CPU in 0.019 seconds (98% CPU, 9577595 Lips)
true.
Edit 29.04.2021:
Oh the irony, bifurcation backtracking is nevertheless challenging.
After fixing a misuse of library(apply_macros), I get:
?- test(100000).
% 374,146 inferences, 0.019 CPU in 0.019 seconds (99% CPU, 19379778 Lips)
% 174,145 inferences, 0.014 CPU in 0.014 seconds (99% CPU, 12400840 Lips)
true.
Does native member/2 contribute to the good maplist solution performance?
But I should do a better measure, with larger times durations.
Open Source:
Sequence Match Problem
https://gist.github.com/jburse/9fd22e8c3e8de6148fbd341817538ef6#file-sequence-pl
I think that it is interresting to observe that complexity O(n²) is not due to the aggregation approach itself, but to the fact that subgoal nth1(Pos,Seq1,X), nth1(Pos,Seq2,X) behaves as a "nested loop" (in the size n of the sequences).
Thus, it should be possible to create another algorithm that, even using aggregation, can have complexity O(n), as long as the "nested loop" is eliminated.
Algorithms to compare
% Original algorithm: Complexity O(n²)
match1(Seq1, Seq2, Count) :-
aggregate_all(count,
( nth1(Pos, Seq1, X),
nth1(Pos, Seq2, X),
memberchk(X, [a,c,g,t]) ),
Count).
% Proposed algorithm: Complexity O(n)
match2(Seq1, Seq2, Count) :-
( maplist([X,Y,X-Y]>>true, Seq1, Seq2, Seq3)
-> aggregate_all(count, (member(X-X, Seq3), X\='_'), Count)
; Count = 0 ).
gimme_random_sequence(Length, Seq) :-
length(Seq, Length),
maplist([E]>>(random_between(0,3,Ix), nth0(Ix, [a,t,c,g], E)), Seq).
test(N) :-
gimme_random_sequence(N, S1),
gimme_random_sequence(N, S2),
time(match1(S1, S2, Count)),
time(match2(S1, S2, Count)).
Simple empirical results
?- test(10000).
% 16,714,057 inferences, 1.156 CPU in 1.156 seconds (100% CPU, 14455401 Lips)
% 39,858 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.
?- test(20000).
% 66,761,535 inferences, 4.594 CPU in 4.593 seconds (100% CPU, 14533123 Lips)
% 79,826 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 5108864 Lips)
true.
?- test(40000).
% 266,856,213 inferences, 19.734 CPU in 19.841 seconds (99% CPU, 13522405 Lips)
% 159,398 inferences, 0.016 CPU in 0.015 seconds (104% CPU, 10201472 Lips)
true.
?- test(80000).
% 1,067,046,835 inferences, 77.203 CPU in 77.493 seconds (100% CPU, 13821291 Lips)
% 320,226 inferences, 0.047 CPU in 0.047 seconds (100% CPU, 6831488 Lips)
true.
Edit 30/04/2021:
Does nth1(I,S,X), nth1(I,S,X) really work as nested loop?
To see that the answer to this question is yes, consider the following simple implementation of nth/3, that counts the number of rounds needed to find each solution, using a global flag:
nth(Index, List, Item) :-
( var(Index)
-> nth_nondet(1, Index, List, Item)
; integer(Index)
-> nth_det(Index, List, Item)
).
nth_det(1, [Item|_], Item) :- !.
nth_det(Index, [_|Rest], Item) :-
flag(rounds, Rounds, Rounds+1),
Index1 is Index - 1,
nth_det(Index1, Rest, Item).
nth_nondet(Index, Index, [Item|_], Item).
nth_nondet(Acc, Index, [_|Rest], Item) :-
flag(rounds, Rounds, Rounds+1),
Acc1 is Acc + 1,
nth_nondet(Acc1, Index, Rest, Item).
To get the number of rounds, you can ask:
?- flag(rounds,_,0), nth(5,[a,b,c,d,e],X), flag(rounds,Rounds,Rounds).
X = e,
Rounds = 4.
Now, using this predicate, we can create a predicate to count the number of rounds of the goal nth(I,L,X), nth(I,L,X), for lists of different lengths:
count_rounds :-
forall(between(1, 10, N),
( Length is 10*N,
count_rounds(Length, Rounds),
writeln(rounds(Length) = Rounds)
)).
count_rounds(Length, _) :-
numlist(1, Length, List),
flag(rounds, _, 0),
nth(Index, List, Item),
nth(Index, List, Item),
fail.
count_rounds(_, Rounds) :-
flag(rounds, Rounds, Rounds).
Empirical results:
?- count_rounds.
rounds(10) = 55
rounds(20) = 210
rounds(30) = 465
rounds(40) = 820
rounds(50) = 1275
rounds(60) = 1830
rounds(70) = 2485
rounds(80) = 3240
rounds(90) = 4095
rounds(100) = 5050
As we can see, the goal nth(I,L,X), nth(I,L,X) computes half of a square matrix of order n (including its diagonal). Thus, the number of rounds for a list of length n is rounds(n) = (n² + n)/2. Hence, the time complexity of this goal is O(n²).
Remark The implementation of the library predicate nth1/3 is a little more efficient than that of predicate nth/3considered for this experiment. Nevertheless, the time complexity of goal nth1(I,S,X), nth1(I,S,X)still is O(n²).
This is a followup of #MostowskiCollapse answer, where I have applied the same optimization that Gertjan van Noord provided for member/2 to pair_member/4, but I have renamed it to member/4.
member(X, Y, [XH|XT], [YH|YT]) :-
member_(XT, YT, X, Y, XH, YH).
member_(_, _, X,Y, X,Y).
member_([XH|XT],[YH|YT], X,Y, _,_) :-
member_(XT,YT, X,Y, XH,YH).
match4(Seq1, Seq2, Count) :-
aggregate_all(count,
(member(X, X, Seq1, Seq2), X \= '_'), Count).
test(N) :-
gimme_random_sequence(N, S1),
gimme_random_sequence(N, S2),
%time(match2(S1, S2, Count)),
time(match3(S1, S2, Count)),
time(match4(S1, S2, Count)).
...
with lists of length 1.000.000 I get
% 1,751,758 inferences, 0.835 CPU in 0.835 seconds (100% CPU, 2098841 Lips)
% 1,751,757 inferences, 0.637 CPU in 0.637 seconds (100% CPU, 2751198 Lips)
that is, a gain of about 25%...
I have two numbers, let's name them N and K, and I want to write N using K powers of 2.
For example if N = 9 and K = 4, then N could be N = 1 + 2 + 2 + 4 (2^0 + 2^1 + 2^1 + 2^2).
My program should output something like N = [1,2,2,4].
I am used to C++. I can't find a way to solve this problem in Prolog. Any help will be appreciated!
I thought this would be a few-liner using CLP(FD), but no dice. Can it be done simpler?
So here is the complete solution.
Don't think I came up with this in one attempt, there are a few iterations and dead ends in there.
:- use_module(library(debug)).
% ---
% powersum(+N,+Target,?Solution)
% ---
% Entry point. Relate a list "Solution" of "N" integers to the integer
% "Target", which is the sum of 2^Solution[i].
% This works only in the "functional" direction
% "Compute Solution as powersum(N,Target)"
% or the "verification" direction
% "is Solution a solution of powersum(N,Target)"?
%
% An extension of some interest would be to NOT have a fixed "N".
% Let powersum/2 find appropriate N.
%
% The search is subject to exponential slowdown as the list length
% increases, so one gets bogged down quickly.
% ---
powersum(N,Target,Solution) :-
((integer(N),N>0,integer(Target),Target>=1) -> true ; throw("Bad args!")),
length(RS,N), % create a list RN of N fresh variables
MaxPower is floor(log(Target)/log(2)), % that's the largest power we will find in the solution
propose(RS,MaxPower,Target,0), % generate & test a solution into RS
reverse(RS,Solution), % if we are here, we found something! Reverse RS so that it is increasing
my_write(Solution,String,Value), % prettyprinting
format("~s = ~d\n",[String,Value]).
% ---
% propose(ListForSolution,MaxPowerHere,Target,SumSoFar)
% ---
% This is an integrate "generate-and-test". It is integrated
% to "fail fast" during proposal - we don't want to propose a
% complete solution, then compute the value for that solution
% and find out that we overshot the target. If we overshoot, we
% want to find ozut immediately!
%
% So: Propose a new value for the leftmost position L of the
% solution list. We are allowed to propose any integer for L
% from the sequence [MaxPowerHere,...,0]. "Target" is the target
% value we must not overshoot (indeed, we which must meet
% exactly at the end of recursion). "SumSoFar" is the sum of
% powers "to our left" in the solution list, to which we already
% committed.
propose([L|Ls],MaxPowerHere,Target,SumSoFar) :-
assertion(SumSoFar=<Target),
(SumSoFar=Target -> false ; true), % a slight optimization, no solution if we already reached Target!
propose_value(L,MaxPowerHere), % Generate: L is now (backtrackably) some value from [MaxPowerHere,...,0]
NewSum is (SumSoFar + 2**L),
NewSum =< Target, % Test; if this fails, we backtrack to propose_value/2 and will be back with a next L
NewMaxPowerHere = L, % Test passed; the next power in the sequence should be no larger than the current, i.e. L
propose(Ls,NewMaxPowerHere,Target,NewSum). % Recurse over rest-of-list.
propose([],_,Target,Target). % Terminal test: Only succeed if all values set and the Sum is the Target!
% ---
% propose_value(?X,+Max).
% ---
% Give me a new value X between [Max,0].
% Backtracks over monotonically decreasing integers.
% See the test code for examples.
%
% One could also construct a list of integers [Max,...,0], then
% use "member/2" for backtracking. This would "concretize" the predicate's
% behaviour with an explicit list structure.
%
% "between/3" sadly only generates increasing sequences otherwise one
% could use that. Maybe there is a "between/4" taking a step value somewhere?
% ---
propose_value(X,Max) :-
assertion((integer(Max),Max>=0)),
Max=X.
propose_value(X,Max) :-
assertion((integer(Max),Max>=0)),
Max>0, succ(NewMax,Max),
propose_value(X,NewMax).
% ---
% I like some nice output, so generate a string representing the solution.
% Also, recompute the value to make doubly sure!
% ---
my_write([L|Ls],String,Value) :-
my_write(Ls,StringOnTheRight,ValueOnTheRight),
Value is ValueOnTheRight + 2**L,
with_output_to(string(String),format("2^~d + ~s",[L,StringOnTheRight])).
my_write([L],String,Value) :-
with_output_to(string(String),format("2^~d",[L])),
Value is 2**L.
:- begin_tests(powersum).
% powersum(N,Target,Solution)
test(pv1) :- bagof(X,propose_value(X,3),Bag), Bag = [3,2,1,0].
test(pv2) :- bagof(X,propose_value(X,2),Bag), Bag = [2,1,0].
test(pv2) :- bagof(X,propose_value(X,1),Bag), Bag = [1,0].
test(pv3) :- bagof(X,propose_value(X,0),Bag), Bag = [0].
test(one) :- bagof(S,powersum(1,1,S),Bag), Bag = [[0]].
test(two) :- bagof(S,powersum(3,10,S),Bag), Bag = [[0,0,3],[1,2,2]].
test(three) :- bagof(S,powersum(3,145,S),Bag), Bag = [[0,4,7]].
test(four,fail) :- powersum(3,8457894,_).
test(five) :- bagof(S,powersum(9,8457894,S), Bag), Bag = [[1, 2, 5, 7, 9, 10, 11, 16, 23]]. %% VERY SLOW
:- end_tests(powersum).
rt :- run_tests(powersum).
Running test of 2 minutes due to the last unit testing line...
?- time(rt).
% PL-Unit: powersum ....2^0 = 1
.2^0 + 2^0 + 2^3 = 10
2^1 + 2^2 + 2^2 = 10
.2^0 + 2^4 + 2^7 = 145
..2^1 + 2^2 + 2^5 + 2^7 + 2^9 + 2^10 + 2^11 + 2^16 + 2^23 = 8457894
. done
% All 9 tests passed
% 455,205,628 inferences, 114.614 CPU in 115.470 seconds (99% CPU, 3971641 Lips)
true.
EDIT: With some suggestive comments from repeat, here is a complete, efficient CLP(FD) solution:
powersum2_(N, Target, Exponents, Solution) :-
length(Exponents, N),
MaxExponent is floor(log(Target) / log(2)),
Exponents ins 0..MaxExponent,
chain(Exponents, #>=),
maplist(exponent_power, Exponents, Solution),
sum(Solution, #=, Target).
exponent_power(Exponent, Power) :-
Power #= 2^Exponent.
powersum2(N, Target, Solution) :-
powersum2_(N, Target, Exponents, Solution),
labeling([], Exponents).
Ordering exponents by #>= cuts down the search space by excluding redundant permutations. But it is also relevant for the order of labeling (with the [] strategy).
The core relation powersum2_/4 posts constraints on the numbers:
?- powersum2_(5, 31, Exponents, Solution).
Exponents = [_954, _960, _966, _972, _978],
Solution = [_984, _990, _996, _1002, _1008],
_954 in 0..4,
_954#>=_960,
2^_954#=_984,
_960 in 0..4,
_960#>=_966,
2^_960#=_990,
_966 in 0..4,
_966#>=_972,
2^_966#=_996,
_972 in 0..4,
_972#>=_978,
2^_972#=_1002,
_978 in 0..4,
2^_978#=_1008,
_1008 in 1..16,
_984+_990+_996+_1002+_1008#=31,
_984 in 1..16,
_990 in 1..16,
_996 in 1..16,
_1002 in 1..16.
And then labeling searches for the actual solutions:
?- powersum2(5, 31, Solution).
Solution = [16, 8, 4, 2, 1] ;
false.
This solution is considerably more efficient than the other answers so far:
?- time(powersum2(9, 8457894, Solution)).
% 6,957,285 inferences, 0.589 CPU in 0.603 seconds (98% CPU, 11812656 Lips)
Solution = [8388608, 65536, 2048, 1024, 512, 128, 32, 4, 2].
Original version follows.
Here is another CLP(FD) solution. The idea is to express "power of two" as a "real" constraint, i.e, not as a predicate that enumerates numbers like lurker's power_of_2/1 does. It helps that the actual constraint to be expressed isn't really "power of two", but rather "power of two less than or equal to a known bound".
So here is some clumsy code to compute a list of powers of two up to a limit:
powers_of_two_bound(PowersOfTwo, UpperBound) :-
powers_of_two_bound(1, PowersOfTwo, UpperBound).
powers_of_two_bound(Power, [Power], UpperBound) :-
Power =< UpperBound,
Power * 2 > UpperBound.
powers_of_two_bound(Power, [Power | PowersOfTwo], UpperBound) :-
Power =< UpperBound,
NextPower is Power * 2,
powers_of_two_bound(NextPower, PowersOfTwo, UpperBound).
?- powers_of_two_bound(Powers, 1023).
Powers = [1, 2, 4, 8, 16, 32, 64, 128, 256|...] ;
false.
... and then to compute a constraint term based on this...
power_of_two_constraint(UpperBound, Variable, Constraint) :-
powers_of_two_bound(PowersOfTwo, UpperBound),
maplist(fd_equals(Variable), PowersOfTwo, PowerOfTwoConstraints),
constraints_operator_combined(PowerOfTwoConstraints, #\/, Constraint).
fd_equals(Variable, Value, Variable #= Value).
constraints_operator_combined([Constraint], _Operator, Constraint).
constraints_operator_combined([C | Cs], Operator, Constraint) :-
Constraint =.. [Operator, C, NextConstraint],
constraints_operator_combined(Cs, Operator, NextConstraint).
?- power_of_two_constraint(1023, X, Constraint).
Constraint = (X#=1#\/(X#=2#\/(X#=4#\/(X#=8#\/(X#=16#\/(X#=32#\/(X#=64#\/(X#=128#\/(... #= ... #\/ ... #= ...))))))))) ;
false.
... and then to post that constraint:
power_of_two(Target, Variable) :-
power_of_two_constraint(Target, Variable, Constraint),
call(Constraint).
?- power_of_two(1023, X).
X in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512 ;
false.
(Seeing this printed in this syntax shows me that I could simplify the code computing the constraint term...)
And then the core relation is:
powersum_(N, Target, Solution) :-
length(Solution, N),
maplist(power_of_two(Target), Solution),
list_monotonic(Solution, #=<),
sum(Solution, #=, Target).
list_monotonic([], _Operation).
list_monotonic([_X], _Operation).
list_monotonic([X, Y | Xs], Operation) :-
call(Operation, X, Y),
list_monotonic([Y | Xs], Operation).
We can run this without labeling:
?- powersum_(9, 1023, S).
S = [_9158, _9164, _9170, _9176, _9182, _9188, _9194, _9200, _9206],
_9158 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9158+_9164+_9170+_9176+_9182+_9188+_9194+_9200+_9206#=1023,
_9164#>=_9158,
_9164 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9170#>=_9164,
_9170 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9176#>=_9170,
_9176 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9182#>=_9176,
_9182 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9188#>=_9182,
_9188 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9194#>=_9188,
_9194 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9200#>=_9194,
_9200 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512,
_9206#>=_9200,
_9206 in ... .. ... \/ 4\/8\/16\/32\/64\/128\/256\/512 ;
false.
And it's somewhat quick when we label:
?- time(( powersum_(8, 255, S), labeling([], S) )), format('S = ~w~n', [S]), false.
% 561,982 inferences, 0.055 CPU in 0.055 seconds (100% CPU, 10238377 Lips)
S = [1,2,4,8,16,32,64,128]
% 1,091,295 inferences, 0.080 CPU in 0.081 seconds (100% CPU, 13557999 Lips)
false.
Contrast this with lurker's approach, which takes much longer even just to find the first solution:
?- time(binary_partition(255, 8, S)), format('S = ~w~n', [S]), false.
% 402,226,596 inferences, 33.117 CPU in 33.118 seconds (100% CPU, 12145562 Lips)
S = [1,2,4,8,16,32,64,128]
% 1,569,157 inferences, 0.130 CPU in 0.130 seconds (100% CPU, 12035050 Lips)
S = [1,2,4,8,16,32,64,128]
% 14,820,953 inferences, 1.216 CPU in 1.216 seconds (100% CPU, 12190530 Lips)
S = [1,2,4,8,16,32,64,128]
% 159,089,361 inferences, 13.163 CPU in 13.163 seconds (100% CPU, 12086469 Lips)
S = [1,2,4,8,16,32,64,128]
% 1,569,155 inferences, 0.134 CPU in 0.134 seconds (100% CPU, 11730834 Lips)
S = [1,2,4,8,16,32,64,128]
% 56,335,514 inferences, 4.684 CPU in 4.684 seconds (100% CPU, 12027871 Lips)
S = [1,2,4,8,16,32,64,128]
^CAction (h for help) ? abort
% 1,266,275,462 inferences, 107.019 CPU in 107.839 seconds (99% CPU, 11832284 Lips)
% Execution Aborted % got bored of waiting
However, this solution is slower than the one by David Tonhofer:
?- time(( powersum_(9, 8457894, S), labeling([], S) )), format('S = ~w~n', [S]), false.
% 827,367,193 inferences, 58.396 CPU in 58.398 seconds (100% CPU, 14168325 Lips)
S = [2,4,32,128,512,1024,2048,65536,8388608]
% 1,715,107,811 inferences, 124.528 CPU in 124.532 seconds (100% CPU, 13772907 Lips)
false.
versus:
?- time(bagof(S,powersum(9,8457894,S), Bag)).
2^1 + 2^2 + 2^5 + 2^7 + 2^9 + 2^10 + 2^11 + 2^16 + 2^23 = 8457894
% 386,778,067 inferences, 37.705 CPU in 37.706 seconds (100% CPU, 10258003 Lips)
Bag = [[1, 2, 5, 7, 9, 10, 11, 16|...]].
There's probably room to improve my constraints, or maybe some magic labeling strategy that will improve the search.
EDIT: Ha! Labeling from the largest to the smallest element changes the performance quite dramatically:
?- time(( powersum_(9, 8457894, S), reverse(S, Rev), labeling([], Rev) )), format('S = ~w~n', [S]), false.
% 5,320,573 inferences, 0.367 CPU in 0.367 seconds (100% CPU, 14495124 Lips)
S = [2,4,32,128,512,1024,2048,65536,8388608]
% 67 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 2618313 Lips)
false.
So this is now about 100x as fast as David Tonhofer's version. I'm content with that :-)
Here's a scheme that uses CLP(FD). In general, when reasoning in the domain of integers in Prolog, CLP(FD) is a good way to go. The idea for this particular problem is to think recursively (as in many Prolog problems) and use a "bifurcation" approach.
As David said in his answer, solutions to problems like this don't just flow out on the first attempt. There are preliminary notions, trial implementations, tests, observations, and revisions that go into coming up with the solution to a problem. Even this one could use more work. :)
:- use_module(library(clpfd)).
% Predicate that succeeds for power of 2
power_of_2(1).
power_of_2(N) :-
N #> 1,
NH #= N // 2,
N #= NH * 2,
power_of_2(NH).
% Predicate that succeeds for a list that is monotonically ascending
ascending([_]).
ascending([X1,X2|Xs]) :-
X1 #=< X2,
ascending([X2|Xs]).
% Predicate that succeeds if Partition is a K-part partition of N
% where the parts are powers of 2
binary_partition(N, K, Partition) :-
binary_partition_(N, K, Partition),
ascending(Partition). % Only allow ascending lists as solutions
binary_partition_(N, 1, [N]) :- % base case
power_of_2(N).
binary_partition_(N, K, P) :-
N #> 1, % constraints on N, K
K #> 1,
length(P, K), % constraint on P
append(LL, LR, P), % conditions on left/right bifurcation
NL #> 0,
NR #> 0,
KL #> 0,
KR #> 0,
NL #=< NR, % don't count symmetrical cases
KL #=< KR,
N #= NL + NR,
K #= KL + KR,
binary_partition_(NL, KL, LL),
binary_partition_(NR, KR, LR).
This will provide correct results, but it also generates redundant solutions:
2 ?- binary_partition(9,4,L).
L = [1, 2, 2, 4] ;
L = [1, 2, 2, 4] ;
false.
As an exercise, you can figure out how to modify it so it only generates unique solutions. :)
my_power_of_two_bound(U,P):-
U #>= 2^P,
P #=< U,
P #>=0.
power2(X,Y):-
Y #= 2^X.
Query:
?- N=9,K=4,
length(_List,K),
maplist(my_power_of_two_bound(N),_List),
maplist(power2,_List,Answer),
chain(Answer, #=<),
sum(Answer, #=, N),
label(Answer).
Then:
Answer = [1, 2, 2, 4],
K = 4,
N = 9
I want to write predicate that generates the Fibonacci series for given N.
fibon(6, X) -> X = [0,1,1,2,3,5].
I have a predicate to generate the N-th element of the Fibonacci series:
fib(0, 0).
fib(1, 1).
fib(N, F) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
fib(N2, F2),
F is F1 + F2.
And I try to write fibon/2, but it doesn't work:
fibon(N, [H|T]) :-
fib(N, H),
N1 is N - 1,
fibon(N1, T).
I solved it like the following:
at_the_end(X, [], [X]).
at_the_end(X, [H|T], [H|T2]) :-
at_the_end(X, T, T2).
revert([], []).
revert([H|T], Out) :-
revert(T, Out1),
at_the_end(H, Out1, Out).
fib(0, 0).
fib(1, 1).
fib(N, F) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
fib(N2, F2),
F is F1 + F2.
fibon(0, [0]).
fibon(N, [H|T]) :-
fib(N, H),
N1 is N - 1,
fibon(N1, T).
fibonacci(In, Out) :-
fibon(In, Out1),
revert(Out1, Out).
You can squeeze out a little more speed by making the recursive predicate tail recursive:
fib_seq(0,[0]). % <- base case 1
fib_seq(1,[0,1]). % <- base case 2
fib_seq(N,Seq) :-
N > 1,
fib_seq_(N,SeqR,1,[1,0]), % <- actual relation (all other cases)
reverse(SeqR,Seq). % <- reverse/2 from library(lists)
fib_seq_(N,Seq,N,Seq).
fib_seq_(N,Seq,N0,[B,A|Fs]) :-
N > N0,
N1 is N0+1,
C is A+B,
fib_seq_(N,Seq,N1,[C,B,A|Fs]). % <- tail recursion
First let's observe that your example query works as expected:
?- fib_seq(6,L).
L = [0, 1, 1, 2, 3, 5, 8] ;
false.
Note that the list doesn't have six elements, as in your example at the beginning of your post, but seven. This is because the predicate starts counting at zero (BTW this is the same behaviour as that of the predicate fibonacci/2 that you added to your post).
For comparison (with fib/2 from #Enigmativity's post) reasons, let's either remove the goal reverse/2 from fib_seq/2 (then you'd get all solutions except N=0 and N=1 in reverse order):
?- time((fib(50000,L),false)).
% 150,001 inferences, 0.396 CPU in 0.396 seconds (100% CPU, 379199 Lips)
false.
?- time((fib_seq(50000,L),false)).
% 150,002 inferences, 0.078 CPU in 0.078 seconds (100% CPU, 1930675 Lips)
false.
Or leave fib_seq/2 as it is and measure fib/2 with an additional goal reverse/2 (then R in the fib/2 solution corresponds to L in the fib_seq/2 solution):
?- time((fib(50000,L),reverse(L,R),false)).
% 200,004 inferences, 0.409 CPU in 0.409 seconds (100% CPU, 488961 Lips)
false.
?- time((fib_seq(50000,L),false)).
% 200,005 inferences, 0.088 CPU in 0.088 seconds (100% CPU, 2267872 Lips)
false.
On a side note, I would urge you to compare your predicate fibonacci/2 with the posted solutions when trying to get bigger lists, say N > 30.
If you're happy to reverse the order of the results for the sequence then this works:
fib(0, [0]).
fib(1, [1,0]).
fib(N, [R,X,Y|Zs]) :-
N > 1,
N1 is N - 1,
fib(N1, [X,Y|Zs]),
R is X + Y.
Then ?- fib(15,Z). gives me [610, 377, 233, 144, 89, 55, 34, 21, 13, 8, 5, 3, 2, 1, 1, 0].
It would be easy to throw in a reverse/3 predicate:
reverse([],Z,Z).
reverse([H|T],Z,A) :- reverse(T,Z,[H|A]).
Just for fun using scanl. and some standard dcgs.
:-use_module(library(clpfd)).
my_plus(X,Y,Z):-
Z#>=0,
Z#=<1000, % Max size optional
Z#=X+Y.
list([]) --> [].
list([L|Ls]) --> [L], list(Ls).
concatenation([]) --> [].
concatenation([List|Lists]) -->
list(List),
concatenation(Lists).
fib(Len,List1):-
X0=1,
length(List1,Len),
length(End,2),
MiddleLen #= Len - 3,
length(Middle,MiddleLen),
phrase(concatenation([[X0],Middle,End]), List1),
phrase(concatenation([[X0],Middle]), List2),
phrase(concatenation([Middle,End]), List3),
scanl(my_plus,List2,X0,List3).
If you want to collect a list of the first N elements of the Fibonacci series you can use the rule below. Just remember to initialize the first 2 predicates.
fib(0, [1]).
fib(1, [1, 1]).
fib(N, L) :-
N > 1,
N1 is N - 1,
N2 is N - 2,
fib(N1, F1),
last(F1, L1),
fib(N2, F2),
last(F2, L2),
L_new is L1 + L2,
append(F1, [L_new], L).
I am doing this problem but I am completely new to Prolog and I have no idea how to do it.
Nine parts of an electronic board have square shape, the same size and each edge of every part is marked with a letter and a plus or minus sign. The parts are to be assembled into a complete board as shown in the figure below such that the common edges have the same letter and opposite signs. Write a planner in Prolog such that the program takes 'assemble' as the query and outputs how to assemble the parts, i.e. determine the locations and positions of the parts w.r.t. the current positions so that they fit together to make the complete board.
I have tried solving it and I have written the following clauses:
complement(a,aNeg).
complement(b,bNeg).
complement(c,cNeg).
complement(d,dNeg).
complement(aNeg,a).
complement(bNeg,b).
complement(cNeg,c).
complement(dNeg,d).
% Configuration of boards, (board,left,top,right,bottom)
conf(b1,aNeg,bNeg,c,d).
conf(b2,bNeg,a,d,cNeg).
conf(b3,dNeg,cNeg,b,d).
conf(b4,b,dNeg,cNeg,d).
conf(b5,d,b,cNeg,aNeg).
conf(b6,b,aNeg,dNeg,c).
conf(b7,aNeg,bNeg,c,b).
conf(b8,b,aNeg,cNeg,a).
conf(b9,cNeg,bNeg,a,d).
position(b1,J,A).
position(b2,K,B).
position(b3,L,C).
position(b4,M,D).
position(b5,N,E).
position(b6,O,F).
position(b7,P,G).
position(b8,Q,H).
position(b9,R,I).
assemble([A,B,C,E,D,F,G,H,I,J,K,L,M,N,O,P,Q,R]) :-
Variables=[(A,J),(B,K),(C,L),(D,M),(E,N),(F,O),(G,P),(H,Q),(I,R)],
all_different(Variables),
A in 1..3, B in 1..3, C in 1..3, D in 1..3, E in 1..3,
F in 1..3, G in 1..3, H in 1..3, I in 1..3, J in 1..3,
K in 1..3, L in 1..3, M in 1..3, N in 1..3, O in 1..3,
P in 1..3, Q in 1..3, R in 1..3,
% this is where I am stuck, what to write next
I don't know even if they are correct and I am not sure how to proceed further to solve this problem.
Trivial with CLP(FD):
:- use_module(library(clpfd)).
board(Board) :-
Board = [[A1,A2,A3],
[B1,B2,B3],
[C1,C2,C3]],
maplist(top_bottom, [A1,A2,A3], [B1,B2,B3]),
maplist(top_bottom, [B1,B2,B3], [C1,C2,C3]),
maplist(left_right, [A1,B1,C1], [A2,B2,C2]),
maplist(left_right, [A2,B2,C2], [A3,B3,C3]),
pieces(Ps),
maplist(board_piece(Board), Ps).
top_bottom([_,_,X,_], [Y,_,_,_]) :- X #= -Y.
left_right([_,X,_,_], [_,_,_,Y]) :- X #= -Y.
pieces(Ps) :-
Ps = [[-2,3,4,-1], [1,4,-3,-4], [-3,2,4,-4],
[-4,-3,4,2], [2,-3,-1,4], [-1,-4,3,2],
[-2,3,2,-1], [-1,-3,1,2], [-2,1,4,-3]].
board_piece(Board, Piece) :-
member(Row, Board),
member(Piece0, Row),
rotation(Piece0, Piece).
rotation([A,B,C,D], [A,B,C,D]).
rotation([A,B,C,D], [B,C,D,A]).
rotation([A,B,C,D], [C,D,A,B]).
rotation([A,B,C,D], [D,A,B,C]).
Example query and its result:
?- time(board(Bs)), maplist(writeln, Bs).
11,728,757 inferences, 0.817 CPU in 0.817 seconds
[[-3, -4, 1, 4], [-1, -2, 3, 4], [4, -4, -3, 2]]
[[-1, 4, 2, -3], [-3, 4, 2, -4], [3, 2, -1, -4]]
[[-2, 1, 4, -3], [-2, 3, 2, -1], [1, 2, -1, -3]]
This representation uses 1,2,3,4 to denote positive a,b,c,d, and -1,-2,-3,-4 for the negative ones.
This is only a tiny improvement to #mat's beautiful solution. The idea is to reconsider the labeling process. That is maplist(board_piece,Board,Ps) which reads (semi-procedurally):
For all elements in Ps, thus for all pieces in that order: Take one piece and place it anywhere on the board rotated or not.
This means that each placement can be done in full liberty. To show you a weak order, one might take: A1,A3,C1,C3,B2 and then the rest. In this manner, the actual constraints are not much exploited.
However, there seems to be no good reason that the second tile is not placed in direct proximity to the first. Here is such an improved order:
...,
pieces(Ps),
TilesOrdered = [B2,A2,A3,B3,C3,C2,C1,B1,A1],
tiles_withpieces(TilesOrdered, Ps).
tiles_withpieces([], []).
tiles_withpieces([T|Ts], Ps0) :-
select(P,Ps0,Ps1),
rotation(P, T),
tiles_withpieces(Ts, Ps1).
Now, I get
?- time(board(Bs)), maplist(writeln, Bs).
% 17,179 inferences, 0.005 CPU in 0.005 seconds (99% CPU, 3363895 Lips)
[[-3,1,2,-1],[-2,3,2,-1],[2,4,-4,-3]]
[[-2,1,4,-3],[-2,3,4,-1],[4,2,-4,-3]]
[[-4,3,2,-1],[-4,1,4,-3],[4,2,-3,-1]]
and without the goal maplist(maplist(tile), Board),
% 11,010 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 3225961 Lips)
and to enumerate all solutions
?- time((setof(Bs,board(Bs),BBs),length(BBs,N))).
% 236,573 inferences, 0.076 CPU in 0.154 seconds (49% CPU, 3110022 Lips)
BBs = [...]
N = 8.
previously (#mat's original version) the first solution took:
% 28,874,632 inferences, 8.208 CPU in 8.217 seconds (100% CPU, 3518020 Lips)
and all solutions:
% 91,664,740 inferences, 25.808 CPU in 37.860 seconds (68% CPU, 3551809 Lips)
In terms of performance, the following is no contender to #false's very fast solution.
However, I would like to show you a different way to formulate this, so that you can use the constraint solver to approximate the faster allocation strategy that #false found manually:
:- use_module(library(clpfd)).
board(Board) :-
Board = [[A1,A2,A3],
[B1,B2,B3],
[C1,C2,C3]],
maplist(top_bottom, [A1,A2,A3], [B1,B2,B3]),
maplist(top_bottom, [B1,B2,B3], [C1,C2,C3]),
maplist(left_right, [A1,B1,C1], [A2,B2,C2]),
maplist(left_right, [A2,B2,C2], [A3,B3,C3]),
pieces(Ps0),
foldl(piece_with_id, Ps0, Pss, 0, _),
append(Pss, Ps),
append(Board, Bs0),
maplist(tile_with_var, Bs0, Bs, Vs),
all_distinct(Vs),
tuples_in(Bs, Ps).
tile_with_var(Tile, [V|Tile], V).
top_bottom([_,_,X,_], [Y,_,_,_]) :- X #= -Y.
left_right([_,X,_,_], [_,_,_,Y]) :- X #= -Y.
pieces(Ps) :-
Ps = [[-2,3,4,-1], [1,4,-3,-4], [-3,2,4,-4],
[-4,-3,4,2], [2,-3,-1,4], [-1,-4,3,2],
[-2,3,2,-1], [-1,-3,1,2], [-2,1,4,-3]].
piece_with_id(P0, Ps, N0, N) :-
findall(P, (rotation(P0,P1),P=[N0|P1]), Ps),
N #= N0 + 1.
rotation([A,B,C,D], [A,B,C,D]).
rotation([A,B,C,D], [B,C,D,A]).
rotation([A,B,C,D], [C,D,A,B]).
rotation([A,B,C,D], [D,A,B,C]).
You can now use the "first fail" strategy of CLP(FD) and try the most constrained elements first. With this formulation, the time needed to find all 8 solutions is:
?- time(findall(t, (board(B), term_variables(B, Vs), labeling([ff],Vs)), Ts)).
2,613,325 inferences, 0.208 CPU in 0.208 seconds
Ts = [t, t, t, t, t, t, t, t].
In addition, I would like to offer the following contender for the speed contest, which I obtained with an extensive partial evaluation of the original program:
solution([[[-4,-3,2,4],[2,-1,-4,3],[2,-1,-3,1]],[[-2,3,4,-1],[4,2,-4,-3],[3,2,-1,-2]],[[-4,1,4,-3],[4,2,-3,-1],[1,4,-3,-2]]]).
solution([[[-3,-4,1,4],[-1,-2,3,4],[4,-4,-3,2]],[[-1,4,2,-3],[-3,4,2,-4],[3,2,-1,-4]],[[-2,1,4,-3],[-2,3,2,-1],[1,2,-1,-3]]]).
solution([[[-3,-2,1,4],[-3,-1,4,2],[4,-3,-4,1]],[[-1,-2,3,2],[-4,-3,4,2],[4,-1,-2,3]],[[-3,1,2,-1],[-4,3,2,-1],[2,4,-4,-3]]]).
solution([[[-3,1,2,-1],[-2,3,2,-1],[2,4,-4,-3]],[[-2,1,4,-3],[-2,3,4,-1],[4,2,-4,-3]],[[-4,3,2,-1],[-4,1,4,-3],[4,2,-3,-1]]]).
solution([[[-3,-1,4,2],[4,-3,-4,1],[2,-1,-4,3]],[[-4,-3,4,2],[4,-1,-2,3],[4,-3,-2,1]],[[-4,-3,2,4],[2,-1,-2,3],[2,-1,-3,1]]]).
solution([[[-1,-3,1,2],[2,-1,-2,3],[4,-3,-2,1]],[[-1,-4,3,2],[2,-4,-3,4],[2,-3,-1,4]],[[-3,2,4,-4],[3,4,-1,-2],[1,4,-3,-4]]]).
solution([[[-1,-4,3,2],[-3,-2,1,4],[-1,-3,1,2]],[[-3,-4,1,4],[-1,-2,3,4],[-1,-2,3,2]],[[-1,4,2,-3],[-3,4,2,-4],[-3,2,4,-4]]]).
solution([[[4,-4,-3,2],[2,-4,-3,4],[2,-3,-1,4]],[[3,2,-1,-2],[3,4,-1,-2],[1,4,-3,-4]],[[1,2,-1,-3],[1,4,-3,-2],[3,2,-1,-4]]]).
The 8 solutions are found very rapidly with this formulation:
?- time(findall(t, solution(B), Ts)).
19 inferences, 0.000 CPU in 0.000 seconds
Ts = [t, t, t, t, t, t, t, t].
I wrote the following program based on the logic that a prime number is only divisible by 1 and itself. So I just go through the process of dividing it to all numbers that are greater than one and less than itself, but I seem to have a problem since I get all entered numbers as true. Here's my code...
divisible(X,Y) :-
Y < X,
X mod Y is 0,
Y1 is Y+1,
divisible(X,Y1).
isprime(X) :-
integer(X),
X > 1,
\+ divisible(X,2).
Thanks in advance :)
I'm a beginner in Prolog but managed to fix your problem.
divisible(X,Y) :- 0 is X mod Y, !.
divisible(X,Y) :- X > Y+1, divisible(X, Y+1).
isPrime(2) :- true,!.
isPrime(X) :- X < 2,!,false.
isPrime(X) :- not(divisible(X, 2)).
The main issue was the statement X mod Y is 0. Predicate is has two (left and right) arguments, but the left argument has to be a constant or a variable that is already unified at the moment that the predicate is executing. I just swapped these values. The rest of the code is for checking number 2 (which is prime) and number less than 2 (that are not primes)
I forgot to mention that the comparison Y < X is buggy, because you want to test for all numbers between 2 and X-1, that comparison includes X.
This answer is a follow-up to #lefunction's previous answer.
isPrime2/1 is as close as possible to isPrime1/1 with a few changes (highlighted below):
isPrime2(2) :-
!.
isPrime2(3) :-
!.
isPrime2(X) :-
X > 3,
X mod 2 =\= 0,
isPrime2_(X, 3).
isPrime2_(X, N) :-
( N*N > X
-> true
; X mod N =\= 0,
M is N + 2,
isPrime2_(X, M)
).
Let's query!
?- time(isPrime1(99999989)).
% 24,999,999 inferences, 3.900 CPU in 3.948 seconds (99% CPU, 6410011 Lips)
true.
?- time(isPrime2(99999989)).
% 5,003 inferences, 0.001 CPU in 0.001 seconds (89% CPU, 6447165 Lips)
true.
X mod Y is 0 always fails, because no expressions allowed on the left of is.
Change to 0 is X mod Y, or, better, to X mod Y =:= 0
agarwaen's accepted answer does not perform well on large numbers. This is because it is not tail recursive (I think). Also, you can speed everything up with a few facts about prime numbers.
1) 2 is the only even prime number
2) Any number greater than half the original does not divide evenly
isPrime1(2) :-
!.
isPrime1(3) :-
!.
isPrime1(X) :-
X > 3,
( 0 is X mod 2
-> false
; Half is X/2,
isPrime1_(X,3,Half)
).
isPrime1_(X,N,Half) :-
( N > Half
-> true
; 0 is X mod N
-> false
; M is N + 2,
isPrime1_(X,M,Half)
).
1 ?- time(isPrime1(999983)).
% 1,249,983 inferences, 0.031 CPU in 0.039 seconds (80% CPU, 39999456 Lips)
true.
EDIT1
Is it possible to take it a step further? isPrime_/3 is more efficient than isPrime2/1 because it compares only to previously known primes. However, the problem is generating this list.
allPrimes(Max,Y) :-
allPrimes(3,Max,[2],Y).
allPrimes(X,Max,L,Y) :-
Z is X+2,
N_max is ceiling(sqrt(X)),
( X >= Max
-> Y = L;
( isPrime_(X,L,N_max)
-> append(L,[X],K), %major bottleneck
allPrimes(Z,Max,K,Y)
; allPrimes(Z,Max,L,Y)
)).
isPrime_(_,[],_).
isPrime_(X,[P|Ps],N_max) :-
( P > N_max
-> true %could append here but still slow
; 0 =\= X mod P,
isPrime_(X,Ps,N_max)
).
I thing that is elegant way:
isPrime(A):-not((A1 is A-1,between(2,A1,N), 0 is mod(A,N))),not(A is 1).
1 IS NOT PRIME NUMBER, but if you don't think so just delete not(A is 1).
Was trying something else. A pseudo primality test based on Fermats little theorem:
test(P) :- 2^P mod P =:= 2.
test2(P) :- modpow(2,P,P,2).
modpow(B, 1, _, R) :- !, R = B.
modpow(B, E, M, R) :- E mod 2 =:= 1, !,
F is E//2,
modpow(B, F, M, H),
R is (H^2*B) mod M.
modpow(B, E, M, R) :- F is E//2,
modpow(B, F, M, H),
R is (H^2) mod M.
Without the predicate modpow/4 things get too slow or integer overflow:
?- time(test(99999989)).
% 3 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 192 Lips)
true.
?- time(test2(99999989)).
% 107 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.
?- time(test(99999999999900000001)).
% 4 inferences, 0.000 CPU in 0.000 seconds (81% CPU, 190476 Lips)
ERROR: Stack limit (1.0Gb) exceeded
?- time(test2(99999999999900000001)).
% 267 inferences, 0.000 CPU in 0.000 seconds (87% CPU, 1219178 Lips)
true.
Not yet sure how to extend it to a full primality test.