Related
The following Prolog program defines a predicate sorted/2 for sorting by permutation (permutation sort) in ascending order a list passed in first argument, which results in the list passed in second argument:
sorted(X, Y) :-
permuted(X, Y),
ordered(Y).
permuted([], []).
permuted(U, [V|W]) :-
permuted(X, W),
deleted(V, U, X).
deleted(X, [X|Y], Y).
deleted(U, [V|W], [V|X]) :-
deleted(U, W, X).
ordered([]).
ordered([_]).
ordered([X, Y|Z]) :-
ordered([Y|Z]), X =< Y.
How to solve the following issues?
The program duplicates solutions for queries in which a list with duplicate elements is passed in second argument:
?- sorted(X, [1, 1, 2]).
X = [1, 1, 2]
; X = [1, 1, 2]
; X = [1, 2, 1]
; X = [1, 2, 1]
; X = [2, 1, 1]
; X = [2, 1, 1]
; false.
The program exhausts resources for queries in which a free variable is passed in second argument:
?- sorted([2, 1, 1], Y).
Y = [1, 1, 2]
; Y = [1, 1, 2]
;
Time limit exceeded
The Prolog program is based on the Horn clause program given at section 11 of Robert Kowalski’s famous paper Predicate Logic as Programming Language:
To solve non-termination, you can add same_length/2 to sorted/2 as #false suggested:
sorted(X, Y) :-
same_length(X, Y),
permuted(X, Y),
ordered(Y).
same_length([], []).
same_length([_|Xs], [_|Ys]) :-
same_length(Xs, Ys).
Or you may embed it into permuted/2 by adding a new argument:
sorted(X, Y) :-
permuted(X, X, Y),
ordered(Y).
permuted([], [], []).
permuted(U, [_|L1], [V|W]) :-
permuted(X, L1, W),
deleted(V, U, X).
The program will still return duplicates as it only sees one item at a time.
To solve duplication, you can either generate all permutations and discard the repeated ones (which is not efficient), or only generate distinct permutations. The following modification does the latter by taking the idea of the recursive procedure permuted/2 + deleted/2 which for each item puts it at the beginning of the list and does a recursive call on the remaining list, and changes it to another recursive procedure permuted_all/2 + deleted_all/2 which for each group of same items puts them at the beginning of the list and does a recursive call on the remaining list. This program uses difference lists for better efficiency:
sorted(X, Y) :-
same_length(X, Y),
permuted_all(X, Y),
ordered(Y).
permuted_all([], []).
permuted_all(U, [V|W]) :-
deleted_all(V, U, X, n-T, [V|W]),
permuted_all(X, T).
% deleted_all(Item, List, Remainder, n-T, Items|T)
deleted_all(_, [], [], y-[X|Xs], [X|Xs]).
deleted_all(X, [V|Y], [V|Y1], y-[X|Xs], Xs1) :-
dif(X, V),
deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(X, [X|Y], Y1, _-Xs, Xs1) :-
deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(U, [V|W], [V|X], n-T, Xs) :-
dif(U, V),
deleted_all(U, W, X, n-T, Xs).
Sample runs:
?- sorted(X, [1, 1, 2]).
X = [1, 2, 1]
; X = [1, 1, 2]
; X = [2, 1, 1]
; false.
?- sorted([2, 1, 1], Y).
Y = [1, 1, 2]
; false.
As per OPs comment asking for a version which does not use difference lists, here goes one which instead obtains the remainder using same_length/2 + append/3 and with added comments:
permuted_all([], []).
permuted_all(U, [V|W]) :-
deleted_all(V, U, X, n, [V|W]),
same_length(X, T), % the remaining list X has the same length as T
append(_, T, [V|W]), % T corresponds to the last items of [V|W]
permuted_all(X, T). % T is a permutation of X
% deleted_all(Item, List, Remainder, n, Items|_)
deleted_all(_, [], [], y, _). % base case
deleted_all(X, [V|Y], [V|Y1], y, Xs1) :-
% recursive step when the current item is not the one we are gathering
dif(X, V),
deleted_all(X, Y, Y1, y, Xs1).
deleted_all(X, [X|Y], Y1, _, [X|Xs1]) :-
% recursive step when the current item is the one we are gathering
deleted_all(X, Y, Y1, y, Xs1).
deleted_all(U, [V|W], [V|X], n, Xs) :-
% recursive step when we have not selected yet the item we will be gathering
dif(U, V),
deleted_all(U, W, X, n, Xs).
Your second problem can by solved by replacing first line with
sorted(X, Y) :-
permuted(X, Y),
ordered(Y),
!.
or
sorted(X, Y) :-
permuted(X, Y),
ordered(Y),
length(X, Z),
length(Y, Z).
The first one is not so easy to solve because of the implementation of this algorithm. Both 1st [1, 1, 2] and 2nd [1, 1, 2] are valid permutations since your code that generated permutations generates all permutations not unique permutations.
I am studying prolog and I am faced with a problem that I cannot deal with.
Given a number, I have to check if the sum of the factorial of each digit that composes it is equal to the number itself.
Example:
145
1! + 4! + 5! = 1 + 24 + 120
Now my problem is just how to decompose the number so that I can factorial and sum each digit.
EDIT1.
thank to #slago I understand how decompose the number, but now I have a problem to sum the factorial terms:
fact(N):-
fact(N, N, _ListNumber).
fact(N, 0, ListNumber):-
factorial(ListNumber, 1, Sum),
Sum == N.
fact(N, Number, [D|R]):-
D is Number mod 10,
Number1 is Number div 10,
fact(N, Number1, R).
factorial([], Counter, Counter).
factorial([D|R], Counter, Sum):-
print([D|R]),
checksum(D, Counter),
factorial(R, Counter, Sum).
checksum(D, Counter):-
Counter1 is Counter * D,
M is D - 1,
M >= 2, !,
checksum(M, Counter1).
I have tried like this, but I noticed [D|R] results empty, and I don't understand why.
Your code is organized in a very confusing way. It is best to code independent predicates (for more specific purposes) and, after that, use them together to get the answer you want.
Start by creating a predicate to decompose a natural number into digits.
decompose(N, [N]) :- N<10, !.
decompose(N, [D|R]) :- N>=10, D is N mod 10, M is N//10, decompose(M, R).
Example of decomposition:
?- decompose(145, D).
D = [5, 4, 1].
Then, create a predicate to compute the factorial of a natural number.
fact(N, F) :- fact(N, 1, F).
fact(0, A, A) :- !.
fact(N, A, F) :- N>0, M is N-1, B is N*A, fact(M, B, F).
Example of factorial:
?- fact(5, F).
F = 120.
After that, create a predicate to map each number of a list into its corresponding factorial (alternatively, you could use the predefined predicate maplist/3).
map_fact([], []).
map_fact([X|Xs], [Y|Ys]) :- fact(X,Y), map_fact(Xs, Ys).
Example of mapping:
?- decompose(145, D), map_fact(D, F).
D = [5, 4, 1],
F = [120, 24, 1].
You must also create a predicate to compute the sum of the items of a list (alternatively, you could use the predefined predicate sum_list/2).
sum(L, S) :- sum(L, 0, S).
sum([], A, A).
sum([X|Xs], A, S) :- B is A+X, sum(Xs, B, S).
Example of summation:
?- decompose(145, D), map_fact(D, F), sum(F, S).
D = [5, 4, 1],
F = [120, 24, 1],
S = 145.
Finally, create the predicate to check the desired number property.
check(N) :- decompose(N, D), map_fact(D, F), sum(F, N).
Example:
?- check(145).
true.
?- check(146).
false.
The problem is about adding the multiples of the possible factorizations in the number that is input by the user.
I tried this code.
sum_factors(N,Fs) :-
integer(N) ,
N > 0 ,
setof(F , factor(N,F) , Fs ).
factor(N,F) :-
L is floor(sqrt(N)),
between(1,L,X),
( F = X ; F is N // X),
write(F), write('x'), write(X), write('='),
write(N), nl.
output of my code if i input 24:
1x1=24
24x1=24
2x2=24
12x2=24
3x3=24
8x3=24
4x4=24
6x4=24
Fs = [1, 2, 3, 4, 6, 8, 12, 24].
the correct output if i input 24 should be:
24 = 2x2x2x3
24 = 2x3x4
24 = 2x2x6
24 = 4x6
24 = 3x8
24 = 2x12
24 = 24
Can somebody explain this code line by line for me, and if possible, tell what's i'm missing from the code.
Try this solution, I think now is complete.
% The first ten prime numbers
% You may want include more, use this URL http://primes.utm.edu/lists/small/1000.txt
prime_numbers([2,3,5,7,11,13,17,19,23,29]).
% Find the lower number in a list of numbers that divide a number N
% We asume that the list of numbers is sorted in ascendent order
lower_splitter(N, [H|_], H):- N mod H =:= 0, !.
lower_splitter(N, [_|T], H):- lower_splitter(N, T, H).
% Find factors
factors(1, []):- !.
factors(N, [R|L]):- prime_numbers(P), lower_splitter(N, P, R), N1 is N div R, factors(N1, L).
% Verify is a list contains a subset
sub_set([], []).
sub_set([X|L1], [X|L2]):- sub_set(L1, L2).
sub_set([_|L1], L2):- sub_set(L1, L2).
% Find all subset in the list X.
combinations(X, R):- setof(L, X^sub_set(X, L), R).
% Auxilary predicates
list([]).
list([_|_]).
lt(X,Y):-var(X);var(Y).
lt(X,Y):-nonvar(X),nonvar(Y),X<Y.
difference([],_,[]).
difference(S,[],S):-S\=[].
difference([X|TX],[X|TY],TZ):-
difference(TX,TY,TZ).
difference([X|TX],[Y|TY],[X|TZ]):-
lt(X,Y),
difference(TX,[Y|TY],TZ).
difference([X|TX],[Y|TY],TZ):-
lt(Y,X),
difference([X|TX],TY,TZ).
%Multiply members of a list
multiply([X], X):-!.
multiply([H|T], X):-multiply(T, M), X is M *H.
start(N):- factors(N, L),
setof(R, L^S^T^D^M^(sub_set(L, S),
length(S, T),
T>1,difference(L, S, D),
multiply(S,M),
append(D,[M], R)), F), writeall(N,[L|F]).
writeall(_,[]).
writeall(N,[H|T]):- write(N),write('='),writelist(H),nl, writeall(N,T).
writelist([X]):- write(X).
writelist([X,Y|T]):- write(X),write(x), writelist([Y|T]).
Consult using the start predicate, like this:
?- start(24).
24=2x2x2x3
24=2x2x6
24=2x3x4
24=2x12
24=3x8
24=24
Say you have the following predicate:
random_int(X/Y):-
random(1,100,X),
random(1,100,Y),
X\=Y.
How can I populate a list of size n using the result of this predicate?
I tried the following code but it only populates the list if random_int(X) is true at the first attempt, i.e. it does not backtrack to try other combinations of X and Y.
findall(X,(between(1,N,_), random_int(X)),L).
I find this small 'application' of clpfd interesting:
?- N=10,M=12, repeat, findall(X, (between(1,N,_),random(1,M,X)), L), clpfd:all_different(L).
N = 10,
M = 12,
L = [5, 4, 6, 7, 9, 11, 2, 3, 8|...]
.
note: M must be > N
I guess a simple way to do it is to make a list of 1:100, and draw 100 times from it a sample of size 2, without replacement. Since this is Prolog and not R, you can instead do:
:- use_module(library(lists)).
:- use_module(library(random)).
random_pairs(Pairs) :-
findall(X/Y,
( between(1, 100, _),
randseq(2, 100, [X,Y])
), R).
This is available in SWI-Prolog at least, but it is free software and the source to randseq/3 is available on the web site.
And since it's better to not use findall unless strictly necessary, it would probable better to write:
random_pairs(Pairs) :-
length(Pairs, 100),
maplist(randseq(2, 100), Pairs).
or, if the X/Y is important,
random_pairs(Pairs) :-
length(Pairs, 100),
maplist(rand_couple(100), Pairs).
rand_couple(N, X/Y) :-
randseq(2, N, [X,Y]).
TL;DR Use the available libraries
You could do it with findall/3:
random_list(N, L) :-
findall(X, (between(1,N,_), random(50,100,X)), L).
Another tidy way to do this would be:
random_list(N, L) :-
length(L, N),
maplist(random(50, 100), L).
Which results in:
| ?- random_list(5, L).
L = [69,89,89,95,59]
yes
| ?-
In general, if you have a predicate, p(X1,X2,...,Xn,Y), and a list you want to fill with result Y using successive calls to p/(n+1), you can use length(List, Length) to set the length of your list, and then maplist(p(X1,...,Xn), List) to populate the list. Or, using the findall/3, you can do findall(X, (between(1,N,_), p(X1,...,Xn,X)), L)..
EDIT based upon the updated conditions of the question that the generated list be unique values...
The random predicates are not generators, so they don't create new random numbers on backtracking (either unique or otherwise). So this solution, likewise, will generate one list which meets the requirements, and then just succeed without generating more such lists on backtracking:
% Generate a random number X between A and B which is not in L
rand_not_in(A, B, L, X) :-
random(A, B, X1),
( memberchk(X1, L)
-> rand_not_in(A, B, L, X)
; X = X1
).
% Generate a list L of length N consisting of unique random numbers
% between A and B
random_list(N, L) :-
random_list(N, 50, 100, [], L).
random_list(N, A, B, Acc, L) :-
N > 0,
rand_not_in(A, B, A, X),
N1 is N - 1,
random_list(N1, A, B, [X|A], L).
random_list(0, _, _, L, L).
Yet another approach, in SWI Prolog, you can use randseq, which will give a random sequence in a range 1 to N. Just scale it:
random_list(N, A, B, L) :-
A < B,
Count is B - A + 1,
randseq(N, Count, L1),
Offset is A - 1,
maplist(offset(Offset), L1, L).
offset(X, Offset, Y) :-
Y is X + Offset.
?- random_list(5, 50, 100, L).
L = [54, 91, 90, 78, 75].
?-
random_len([],0).
random_len([Q|T],N) :-
random(1,100,Q),
random_len(T,X),
N is X+1.
example
divisible([L1],X) :-
L1 mod X =:= 0.
query
divisible([4,6,8,7],2).
response
[4,6,8]
Any guidance?
divisible([], _, []).
divisible([H|T], X, [H|T1]) :- H mod X =:= 0, divisible(T, X, T1).
divisible([H|T], X, T1) :- H mod X =\= 0, divisible(T, X, T1).
You are going to need a three-argument predicate (input list, value to test for divisibility, and output list). After that, think about the three cases: input list is empty, first element is not divisible by number, and first element is divisible by number. You should be able to write three clauses, one for each of those, and get a correct predicate.
SWI-Prolog has a nice predicate include/3 which you can use like this:
?- include(divides(2), [4, 6, 8, 7], L).
L = [4, 6, 8].
given that you have defined divides/2:
% Succeeds if X divides Y
divides(X, Y) :-
Y mod X =:= 0.
Use meta-predicate tfilter/3 in tandem with the reified test predicate divisor_of_t/3:
?- tfilter(divisor_of_t(2),[4,6,8,7],Zs).
Zs = [4, 6, 8].
Based on clpfd and bool01_truth/2, we can define divisor_of_t/3 as follows:
:- use_module(library(clpfd)).
divisor_of_t(Y,X,Truth) :- X mod Y #= 0 #<==> B, bool01_truth(B,Truth).