Find minimum of various predicates - prolog

I want to find the minimum value of all permutations called from main predicate. For simplicity, I have removed my entire code, assume that I just want to find the minimum of head elements of all permutations.
appendlist([], X, X).
appendlist([T|H], X, [T|L]) :- appendlist(H, X, L).
permutation([], []).
permutation([X], [X]) :-!.
permutation([T|H], X) :- permutation(H, H1), appendlist(L1, L2, H1), appendlist(L1, [T], X1), appendlist(X1, L2, X).
%min(X, A, B) X is the minimum of A, B
min(X, X, Y) :- X =< Y.
min(Y, X, Y) :- Y < X.
solve([Head|Rest], Head):-
writeln([Head|Rest]).
main :-
Sort = [1, 2, 3],
PrvAns is 1000,
permutation(Sort, X),
solve(X, Here),
min(Ans, Here, PrvAns),
writeln(Ans),
PrvAns = Ans,
!, fail;
true,
writeln(PrvAns).
I want to calculate the minimum on fly for each permutation. Now, permute is working fine, and you can see that solve prints all permutations and even returns the first value Head properly, but PrvAns = Ans is wrong.
Expected output PrvAns : 1

I'm sorry if I didn't understand properly (and tell me, so I can help you), but, you mean something like this?
findMinHead(X,Z):-
findall( Y, ( permutation(X,[Y|_]) ), Z1 ),
min_list(Z1,Z).
in this predicate we find all the Y values where Y is the head of a permutation of X, put all that values in a bag, and then find the min.

Related

implementation of copy in prolog

Given a list of regs regs (1,2,3, ...) what I want the code to do is to copy the position X to X + 1, I put some examples below. I have the following code in prolog:
exe(EA, copy(X), ES):-
EA =.. [reg|TH],
LL1 is X+1,
length(TH,LL),
LL2 is LL+X+1,
length(L1,LL1),
length(L2,LL2),
append(L1,LI1,TH),[EX|L2]=LT1,
flatten(reg[L1,EX,L2], LR),
ES=.. LR.
what i want to show me as a result is:
?- exe(reg(1,2,3,4), copy(2), ES).
result:
?- ES=reg(1,2,2,4)
?- exe(reg(4,6,2,9), copy(1), ES).
result:
?-ES=reg(4,4,2,9).
?- exe(reg(1,2), copy(2), ES).
result:
false
I think the code is wrong
Try to split up your goal into multiple aspects, like: getting the element at position X (nth_element), then try to implement a predicate overwriting a particular value. Below is code that works as you expect. It basically traverses lists in the Prolog-"standard" way.
% Get the nth element of a list, indices starting at 1
nth_element([X|_], 1, X) :- !.
nth_element([_|Xs], N, R) :-
M is N - 1,
nth_element(Xs, M, R).
% Overwrites the N-th position in a list by a new element
% Indices starting with 1
% overwrite(List, N, Element, New_List) :-
% overwrite([], _, _, []) :- !.
overwrite([_|Xs], 1, Y, [Y|Xs]) :- !.
overwrite([X|Xs], N, Y, [X|Ys]) :-
M is N - 1,
overwrite(Xs, M, Y, Ys).
exe(EA, copy(X), Es):-
EA =.. [reg|TH],
nth_element(TH, X, Element),
Y is X + 1,
overwrite(TH, Y, Element, New),
Es =.. [reg|New].

Find min of list using fail, backtracking Prolog

I want to calculate the minimum of list, using fail which causes to backtrack. How do i change min(Min, X, Min), to make it work.
%min(X, A, B) X is the min of A, B
min(X, X, Y) :- X =< Y.
min(Y, X, Y) :- Y < X.
member(X, [X|_]).
member(X, [_|Ys]) :-
member(X,Ys).
program :-
Min is 1000,
(member(X, [1, 2, 3, 4]),
writeln(X),
min(Min, X, Min), %This is wrong !
fail;
writeln(Min),
true).
My previous working code for calculating min
solve([Head|Rest], Ans) :-
solve(Rest, Till),
min(Ans, Head, Till).
But i do not want to do this, as for calling solve, i am doing something like this
program :-
findall(X, solve(List, X), Z).
which is causing to find all solutions of X and storing in memory. This method is not working for large inputs, getting killed.
Hence, i want to calculate the min of each solve call on fly and not store as did using findall.
If you're worried about memory usage, you shouldn't be using a guess-and-check metaphor (which using failure implies you're using). There's an O(n) algorithm that doesn't require failure at all.
minlist(Min, [X|Xs]) :- minlist(X, Xs, Min).
minlist(Min, [], Min).
minlist(MinSoFar, [X|Xs], Min) :-
min(NextMin, MinSoFar, X),
minlist(NextMin, Xs, Min).

Swapping sublists in prolog

I'm searching for a compact predicate to swap sublists of fixed length within a larger list. For example, if sublists have size 3 then
[a,t,t,g,c,c]
becomes
[g,c,c,a,t,t]
I ended up with the following program:
dna_sub(A,B,X,Xe) :-
append(A1,_,A),
length(A1,Xe),
append(B1,B,A1),
length(B1,X).
dna_swap(A,B,X,Xe,Y,Ye) :-
length(A, Size),
dna_sub(A,Part1, 0, X),
dna_sub(A,Part2, X, Xe),
dna_sub(A,Part3, Xe, Y),
dna_sub(A,Part4, Y, Ye),
dna_sub(A,Part5, Ye, Size),
append(Part1, Part4, Tmp),
append(Tmp, Part3, Tmp2),
append(Tmp2, Part2, Tmp3),
append(Tmp3, Part5, B).
dna_swap(A,B) :-
length(A, Size),
Limit is Size - 3,
between(0,Limit, X),
Xe is X + 3,
Xs is Xe,
between(Xs, Size, Y),
Ye is Y + 3,
dna_swap(A,B,X,Xe,Y,Ye).
It seems to be working. For example, the following query:
dna_swap([t,a,g,t,g,c], L).
Obtains the correct answer in L.
Anyway, as you can see, it's very verbose. Is there a better way?
Edit
This seems to work a lot better:
dna_swap(A,B) :-
append(Left1, [X1,X2,X3|Right1], A),
append(Left2, [Y1,Y2,Y3|Right2], Right1),
append(Left1, [Y1,Y2,Y3|Left2], Tmp),
append(Tmp, [X1,X2,X3|Right2], B).
sublists(List,Count,A,B) :-
length(A,Count),
append(A,B,List).
swap(List,Count,SwappedList) :-
sublists(List,Count,A,B),
append(B,A,SwappedList).
Hope this is what you are looking for:
4 ?- swap([a,b,c,d],2,S).
S = [c, d, a, b].

List building problems

For my program I need to make a list of lists, with each sublist containing 2 numbers, X and Y along with the sum and product of these 2 numbers.
So far I have the following:
genList(95, X,[]):-!.
genList(N, X,[[X,Y,Sum,Product]|Xs]):-
Y is N+1,
Sum is X+Y,
Sum<101,
Product is X*Y,
N1 is N+1,
genList(N1, X,Xs).
This works just fine for my test case of genList(5,5,Q).
However, I'm having trouble making it work for any starting number.
The goal is to find every pair of numbers where sum<= 100. So running through the above for one starting value, X would find every pair 1 < X < Y, where sum<=100, and running through it with all numbers 2-N would give a complete list of possible pairs.
For those interested, the problem I'm working through is the sum/product problem, described here (Second on the page)
If anyone could help with this it would be greatly appreciated!
Also, no built in prolog predicates are able to be used, hence the complicated way of doing this rather than with a findall.
A small extract of the output produced by this predicated is as follows:
[[5,6,11,30],[5,7,12,35],[5,8,13,40],[5,9,14,45],[5,10,15,50],[5,11,16,55],[5,12,17,60],[5,13,18,65],[5,14,19,70],[5,15,20,75],[5,16,21,80],[5,17,22,85],[5,18,23,90],[5,19,24,95],[5,20,25,100],[5,21,26,105],[5,22,27,110], ...
EDIT:
Ok, so after some editing, here is the latest version of my code.
I think it's very close, but there's still something not quite right.
It cycles through number pairs, but requires the use of ";" to view all the answers, which isn't what I want. Additionally, it returns false after all the answers are exhausted. I just can't figure it out.
Also, it gives a complete answer in the middle, but then removes a sublist each time until I'm left with only the last set of pairs.
E.g. genList(0,48,48,Q). gives me:
[[48,49,97,2352],[48,50,98,2400],[48,51,99,2448],[48,52,100,2496]]
[[48,49,97,2352],[48,50,98,2400],[48,51,99,2448],[48,52,100,2496],[49,50,99,2450],[49,51,100,2499]]
[[48,49,97,2352],[48,50,98,2400],[48,51,99,2448],[49,50,99,2450],[49,51,100,2499]]
[[48,49,97,2352],[48,50,98,2400],[49,50,99,2450],[49,51,100,2499]]
[[48,49,97,2352],[49,50,99,2450],[49,51,100,2499]]
[[49,50,99,2450],[49,51,100,2499]]
false.
As you can see, a sublist gets removed each time, I just can't see why!
You can exploit Prolog backtracking here. Just state what you want. For example you could say:
I want X to be between 1 and 100.
I want Y to be between 1 and min(100 - X, X).
then I want their pair
Let's look at what a validPair/1 predicate would look like:
validPair(X-Y) :-
between(1, 100, X),
Limit is min(100 - X, X),
between(1, Limit, Y).
You can just call it with
?- validPair(X).
and browse results with ;, or build a list of all the matching pairs with findall/3.
Edit: even with recursion, we can keep our statements:
I want X to be between 1 and 100.
I want Y to be between 1 and min(100 - X, X).
then I want their pair
So, an idea to do it would be to set up a worker predicate:
validPair(Result) :-
validPair(0, 0, Result).
validPair(X, Y, R) :-
...
then set up the base case:
validPair(101, _Y, []) :- !.
and in the worker predicate, to implement the statements we made with some conditions:
validPair(X, Y, [SomeStuff|R]) :-
X =< 100,
Limit is min(100 - X, X),
Y =< Limit,
!,
% we can go on and increment Y once we're finished
validPair(X, NextY, R).
validPair(X, Y, R) :-
% if we come here that means that Y is finished growing and
% we have to increment X
NextX is X + 1,
validPair(NextX, 0, R).
I have a feeling you're tackling the problem the wrong way; I must admit I don't really understand what your predicate is doing.
The goal is to find every pair of numbers where sum<= 100.
Assuming you mean unordered pairs of non-negative integers, that's
between(0, 100, Sum),
between(0, Sum, X),
Y is Sum - X,
X =< Y.
The set of all such pairs (as a list) can then be constructed with findall/3.
You could also do this using CLP(fd):
use_module(library(clpfd)).
[X, Y, Sum] ins 0..100,
X #=< Y,
X + Y #= Sum,
label([X,Y,Sum]).

Prolog: Remove all elements from lister higher than X

I am trying to write a prolog program that will remove all elements in a list higher than the value X.
For example, I want to remove all elements higher than 50 from this list:
[2,8,18,34,40,44,46,51,52,54,64,66,76,90]
So I get:
[2,8,18,34,40,44,46]
It would be nice to see how far you've gotten. What is giving you problems?
The idea in most of these problems usually goes something like this:
Construct a base case, usually empty lists.
Try to recurse to the bottom of the recursion and on the way,
only keep the desired elements. Here, keeping means that you recurse
with the unwanted elemements removed.
For it to "grow back together" properly, as in, when the recursion
goes back up, you have to properly define the output list.
There are really two ways to this. Either remove elements when going down, or ignore them when going back up. These are in essence the same.
I'm not the best at explaining this. I will simply post my solution. But I strongly suggest you give it your best before looking at it. :)
delete_gt([], _, []) :- !.
delete_gt([Head|Rest], X, L) :-
Head > X, !,
delete_gt(Rest, X, L).
delete_gt([Head|Rest], X, [Head|L]) :-
delete_gt(Rest, X, L).
Using accumulator
removeHigherThan( X, List, Ans) :-
removeHigherThan( X, List, Ans, [] ), !.
removeHigherThan( _, [], Ans, Ans).
removeHigherThan( X, [H | Tail], Ans, Acc ) :-
(
( H > X, NewEl = [] )
;
( H =< X, NewEl = [H] )
),
append( Acc, NewEl, NewAcc ),
removeHigherThan( X, Tail, Ans, NewAcc).
It works like that
?- removeHigherThan(10, [1,4], X).
X = [1, 4].
?- removeHigherThan(10, [1,12,4], X).
X = [1, 4].
You could also consider this utility from apply library
del_elems_higher :-
exclude(condition, [2,8,18,34,40,44,46,51,52,54,64,66,76,90], L), writeln(L).
condition(X) :- X > 50.
test:
?- del_elems_higher.
[2,8,18,34,40,44,46]

Resources