Can some1 help me with SWI-Prolog? [closed] - prolog

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 2 months ago.
Improve this question
List the choice of another list after each visit to X if X
included in the original list.
For example, [1,2,1,5,3], X=1, [0,7,9]-> [1,0,7,9,2,1,0,7,9,5,3]
I did some code, but it's not working...
insert([], _, [], []) :- !.
insert([H|T], X, Sub, [Res]) :-
H =\= X, !.
insert([X|T], X, Sub, [Res]) :-
insert(T, X, Sub, [X|Sub]).


It's working code:
insert([], _, [], []) :- !.
insert([], X, Sub, Res) :- !.
insert([H|T], X, Sub, Res) :-
not(Res = []),
H = X,
insert(T, X, Sub, [Res|[H|Sub]]).
insert([H|T], X, Sub, Res) :-
Res = [],
H = X,
insert(T, X, Sub, [H|Sub]).
insert([H|T], X, Sub, Res) :-
Res = [],
member(X,T),
insert(T, X, Sub, H).
insert([H|T], X, Sub, Res) :-
member(X,T),
insert(T, X, Sub, [Res|[H]]).
insert(List, X, Sub, Res) :-
insert([], X, Sub, [Res|List]),
append(Res, List, Z),
flatten(Z, Result),
writeln(Result).

Related

Lists size multiplication

I'm new to Prolog and I'm trying to get my head around lists. The problem I'm struggling with is:
Given numbers in the form of lists (1 : [x], 3: [x, x, x]), implement the 'times' predicate /3.
E.g.: times([x, x], [x, x, x], R).
R = [x, x, x, x, x, x].
The plus, and successor predicates where 2 previous points of the exercise. I know I'm not using the successor predicate, but it didn't seem that useful later on.
This is what i've tried so far
successor([], [x]).
successor([X|T], R) :-
append([X|T], [X], R).
plus(L1, L2, R) :- append(L1, L2, R).
times([], _, []).
times(_, [], []).
times([_], L, L).
times(L, [_], L).
times([_|T], L2, R) :- plus(L2, R, RN),
times(T, L2, RN).
The output is:
R is [].

I think you make things too complicated here. You can define successor as:
successor(T, [x|T]).
We can define plus/3 as:
plus([], T, T).
plus([x|R], S, [x|T]) :-
plus(R, S, T).
This is more or less the implementation of append/3, except that here we check if the first list only contains x.
For times/3 we know that if the first item is empty, the result is empty:
times([], _, []).
and for a times/3 where the first item has shape [x|R], we need to add the second item to the result of a call to times/3 with R:
times([x|R], S, T) :-
times(R, S, T1),
plus(S, T1, T).
So putting it all together, we obtain:
successor(T, [x|T]).
plus([], T, T).
plus([x|R], S, [x|T]) :-
plus(R, S, T).
times([], _, []).
times([x|R], S, T) :-
times(R, S, T1),
plus(S, T1, T).

Prolog: Optimizing a puzzle solver after trying really hard

I am trying to solve a 15 puzzle in Prolog, I need to find the minimal number of moves.
Here we have a sample puzzle with detailed answer. https://rosettacode.org/wiki/15_puzzle_solver
I am using A* search, using manhattan distance as the heuristic.
To start with, I made sure the program is deterministic. Rules either doesn't apply, or fail quickly, or run to completion without backtracking. To optimize for space, I used a single number to represent the state. The search queue is optimized using a binomial queue, the visited check is optimized using a hashtrie. However, the performance is still awful.
Here is my implementation for the binomial queue:
:- module(myheap, [myHeapInsert/4, myHeapDeleteMin/4]).
mergeOneTree(Tree, [], [Tree]) :-
Tree = binomialQueueNode(_, _, _, _), !.
mergeOneTree(Tree, [Head|Tail], [Tree,Head|Tail]) :-
Tree = binomialQueueNode(Size, _, _, _),
Head = binomialQueueNode(Head_Size, _, _, _),
Size < Head_Size,
!.
mergeOneTree(Tree, [Head|Tail], Result) :-
Tree = binomialQueueNode(Size, Data, Priority, Subtree_Content-Subtree_Indeterminate),
Head = binomialQueueNode(Size, _, Head_Priority, _),
Priority < Head_Priority,
Concatenation = Subtree_Content-Concatenation_Indeterminate,
Subtree_Indeterminate = [Head|Concatenation_Indeterminate],
DoubleSize is Size *2,
mergeOneTree(binomialQueueNode(DoubleSize, Data, Priority, Concatenation), Tail, Result),
!.
mergeOneTree(Tree, [Head|Tail], Result) :-
Tree = binomialQueueNode(Size, _, Priority, _),
Head = binomialQueueNode(Size, Head_Data, Head_Priority, Head_Subtree_Content-Head_Subtree_Indeterminate),
Priority >= Head_Priority,
Concatenation = Head_Subtree_Content-Concatenation_Indeterminate,
Head_Subtree_Indeterminate = [Tree|Concatenation_Indeterminate],
DoubleSize is Size *2,
mergeOneTree(binomialQueueNode(DoubleSize, Head_Data, Head_Priority, Concatenation), Tail, Result),
!.
mergeOneTree(Tree, [Head|Tail], [Head|TailResult]) :-
Tree = binomialQueueNode(Size, _, _, _),
Head = binomialQueueNode(Head_Size, _, _, _),
Size > Head_Size,
mergeOneTree(Tree, Tail, TailResult),
!.
merge([], X, X) :- !.
merge([H|T], X, R) :- mergeOneTree(H, X, I), merge(T, I, R), !.
findMinTree([H|T], MinTree, Others) :-
findMinTree(H, T, MinTree, Others), !.
findMinTree(CurrentMin, [], CurrentMin, []) :- !.
findMinTree(CurrentMin, [Candidate|Tail], ResultMinTree, [Candidate|ResultOthers]) :-
CurrentMin = binomialQueueNode(_, _, CurrentMin_Priority, _),
Candidate = binomialQueueNode(_, _, Candidate_Priority, _),
Candidate_Priority > CurrentMin_Priority,
findMinTree(CurrentMin, Tail, ResultMinTree, ResultOthers),
!.
findMinTree(CurrentMin, [Candidate|Tail], ResultMinTree, [CurrentMin|ResultOthers]) :-
CurrentMin = binomialQueueNode(_, _, CurrentMin_Priority, _),
Candidate = binomialQueueNode(_, _, Candidate_Priority, _),
Candidate_Priority =< CurrentMin_Priority,
findMinTree(Candidate, Tail, ResultMinTree, ResultOthers),
!.
myHeapInsert(BeforeTree, Data, Priority, AfterTree) :-
mergeOneTree(binomialQueueNode(1, Data, Priority, Dummy-Dummy), BeforeTree, AfterTree), !.
myHeapDeleteMin(BeforeTree, MinData, MinPriority, AfterTree) :-
findMinTree(BeforeTree, MinTree, Others),
MinTree = binomialQueueNode(_, MinData, MinPriority, MinTreeSubTree_Content-MinTreeSubTree_Indeterminate),
MinTreeSubTree_Indeterminate = [],
merge(Others, MinTreeSubTree_Content, AfterTree),
!.
Here is my implementation for the hash trie:
:- module(myhash, [myHashEmpty/1, myHashGet/4, myHashPut/5]).
reverseBinary(0, 0, []).
reverseBinary(0, L, [0|R]) :- L > 0, D is L - 1, reverseBinary(0, D, R), !.
reverseBinary(1, L, [1|R]) :- L > 0, D is L - 1, reverseBinary(0, D, R), !.
reverseBinary(N, L, Result) :- N > 1, R is N mod 2, Q is (N - R) / 2, D is L - 1, reverseBinary(Q, D, QR), Result = [R|QR], !.
getValue([H|T], Key, Value) :- H = pair(Key, Value); getValue(T, Key, Value), !.
getHash(Key, [], hashTrieLeaf(Values), Value) :- getValue(Values, Key, Value), !.
getHash(Key, [0|T], hashTrieNode(Left,_), Value) :- getHash(Key, T, Left, Value), !.
getHash(Key, [1|T], hashTrieNode(_,Right), Value) :- getHash(Key, T, Right, Value), !.
putHash(Tuple, [], hashTrieNil, hashTrieLeaf([Tuple])) :- !.
putHash(Tuple, [], hashTrieLeaf(Tuples), hashTrieLeaf([Tuple|Tuples])) :- !.
putHash(Tuple, [0|T], hashTrieNil, hashTrieNode(LeftResult, hashTrieNil)) :-
putHash(Tuple, T, hashTrieNil, LeftResult), !.
putHash(Tuple, [0|T], hashTrieNode(Left,Right), hashTrieNode(LeftResult, Right)) :-
putHash(Tuple, T, Left, LeftResult), !.
putHash(Tuple, [1|T], hashTrieNil, hashTrieNode(hashTrieNil, RightResult)) :-
putHash(Tuple, T, hashTrieNil, RightResult), !.
putHash(Tuple, [1|T], hashTrieNode(Left,Right), hashTrieNode(Left, RightResult)) :-
putHash(Tuple, T, Right, RightResult), !.
myHashEmpty(hashTrieNil) :- !.
myHashGet(HashMap, Key, Hash, Value) :- reverseBinary(Hash, 30, HashBits), getHash(Key, HashBits, HashMap, Value), !.
myHashPut(BeforeHashMap, Key, Hash, Value, AfterHashMap) :- reverseBinary(Hash, 30, HashBits), putHash(pair(Key, Value), HashBits, BeforeHashMap, AfterHashMap), !.
And finally, the puzzle solving code:
:- 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)).
:- use_module(myheap).
:- use_module(myhash).
hash([], 0) :- !.
hash([H|T], Hash) :- hash(T, R), Hash is (H + 23 * R) mod 1073741824, !.
flatten([[A,B,C,D],[E,F,G,H],[I,J,K,L],[M,N,O,P]],[A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P]) :- !.
moves([0,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X10,X01,X02,X03,0,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X10),move([X01,0,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X01)]) :- !.
moves([X00,0,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([0,X00,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X00),move([X00,X11,X02,X03,X10,0,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X11),move([X00,X02,0,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X02)]) :- !.
moves([X00,X01,0,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,0,X01,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X01),move([X00,X01,X12,X03,X10,X11,0,X13,X20,X21,X22,X23,X30,X31,X32,X33],X12),move([X00,X01,X03,0,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X03)]):- !.
moves([X00,X01,X02,0,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,0,X02,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X02),move([X00,X01,X02,X13,X10,X11,X12,0,X20,X21,X22,X23,X30,X31,X32,X33],X13)]):- !.
moves([X00,X01,X02,X03,0,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([0,X01,X02,X03,X00,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X00),move([X00,X01,X02,X03,X20,X11,X12,X13,0,X21,X22,X23,X30,X31,X32,X33],X20),move([X00,X01,X02,X03,X11,0,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X11)]):- !.
moves([X00,X01,X02,X03,X10,0,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,0,X02,X03,X10,X01,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X01),move([X00,X01,X02,X03,0,X10,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33],X10),move([X00,X01,X02,X03,X10,X21,X12,X13,X20,0,X22,X23,X30,X31,X32,X33],X21),move([X00,X01,X02,X03,X10,X12,0,X13,X20,X21,X22,X23,X30,X31,X32,X33],X12)]):- !.
moves([X00,X01,X02,X03,X10,X11,0,X13,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,0,X03,X10,X11,X02,X13,X20,X21,X22,X23,X30,X31,X32,X33],X02),move([X00,X01,X02,X03,X10,0,X11,X13,X20,X21,X22,X23,X30,X31,X32,X33],X11),move([X00,X01,X02,X03,X10,X11,X22,X13,X20,X21,0,X23,X30,X31,X32,X33],X22),move([X00,X01,X02,X03,X10,X11,X13,0,X20,X21,X22,X23,X30,X31,X32,X33],X13)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,0,X20,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,X02,0,X10,X11,X12,X03,X20,X21,X22,X23,X30,X31,X32,X33],X03),move([X00,X01,X02,X03,X10,X11,0,X12,X20,X21,X22,X23,X30,X31,X32,X33],X12),move([X00,X01,X02,X03,X10,X11,X12,X23,X20,X21,X22,0,X30,X31,X32,X33],X23)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,0,X21,X22,X23,X30,X31,X32,X33],[move([X00,X01,X02,X03,0,X11,X12,X13,X10,X21,X22,X23,X30,X31,X32,X33],X10),move([X00,X01,X02,X03,X10,X11,X12,X13,X30,X21,X22,X23,0,X31,X32,X33],X30),move([X00,X01,X02,X03,X10,X11,X12,X13,X21,0,X22,X23,X30,X31,X32,X33],X21)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,0,X22,X23,X30,X31,X32,X33],[move([X00,X01,X02,X03,X10,0,X12,X13,X20,X11,X22,X23,X30,X31,X32,X33],X11),move([X00,X01,X02,X03,X10,X11,X12,X13,0,X20,X22,X23,X30,X31,X32,X33],X20),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X31,X22,X23,X30,0,X32,X33],X31),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X22,0,X23,X30,X31,X32,X33],X22)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,0,X23,X30,X31,X32,X33],[move([X00,X01,X02,X03,X10,X11,0,X13,X20,X21,X12,X23,X30,X31,X32,X33],X12),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,0,X21,X23,X30,X31,X32,X33],X21),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X32,X23,X30,X31,0,X33],X32),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X23,0,X30,X31,X32,X33],X23)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,0,X30,X31,X32,X33],[move([X00,X01,X02,X03,X10,X11,X12,0,X20,X21,X22,X13,X30,X31,X32,X33],X13),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,0,X22,X30,X31,X32,X33],X22),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X33,X30,X31,X32,0],X33)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,0,X31,X32,X33],[move([X00,X01,X02,X03,X10,X11,X12,X13,0,X21,X22,X23,X20,X31,X32,X33],X20),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X31,0,X32,X33],X31)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,0,X32,X33],[move([X00,X01,X02,X03,X10,X11,X12,X13,X20,0,X22,X23,X30,X21,X32,X33],X21),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,0,X30,X32,X33],X30),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X32,0,X33],X32)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,0,X33],[move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,0,X23,X30,X31,X22,X33],X22),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,0,X31,X33],X31),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X33,0],X33)]):- !.
moves([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,0],[move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,0,X30,X31,X32,X23],X23),move([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,0,X32],X32)]):- !.
debug([X00,X01,X02,X03,X10,X11,X12,X13,X20,X21,X22,X23,X30,X31,X32,X33]) :- true,write(X00),write('\t'),write(X01),write('\t'),write(X02),write('\t'),write(X03),write('\t'),write('\n'),write(X10),write('\t'),write(X11),write('\t'),write(X12),write('\t'),write(X13),write('\t'),write('\n'),write(X20),write('\t'),write(X21),write('\t'),write(X22),write('\t'),write(X23),write('\t'),write('\n'),write(X30),write('\t'),write(X31),write('\t'),write(X32),write('\t'),write(X33),write('\t'),write('\n'),write('\n').
easy([[1, 2, 3, 4],[5, 6, 0, 8],[9, 10, 7, 11],[13, 14, 15, 12]]).
hard([[15, 14, 1, 6],[ 9, 11, 4, 12],[ 0, 10, 7, 3],[13, 8, 5, 2]]).
dist(A, B, C) :- C is A - B, C >= 0, !.
dist(A, B, C) :- C is B - A, C >= 0, !.
manhattan(L, D) :- manhattan(L, 0, D), !.
manhattan([], _, 0) :- !.
manhattan([0|T], L, D) :-
NextL is L + 1,
manhattan(T, NextL, D),
!.
manhattan([H|T], L, D) :-
H > 0,
CellCol is L mod 4,
CellRow is (L - CellCol) / 4,
DataCol is (H - 1) mod 4,
DataRow is (H - 1- DataCol) / 4,
dist(CellCol, DataCol, CD),
dist(CellRow, DataRow, RD),
NextL is L + 1,
manhattan(T, NextL, TD),
D is CD + RD + TD,
!.
compress([], 0) :- !.
compress([H|T], L) :- compress(T, I), L is I * 16 + H, !.
uncompress(L, R) :- uncompress(L, 16, R), !.
uncompress(_, 0, []) :- !.
uncompress(L, C, [H|T]) :- C > 0, D is C - 1, H is L mod 16, R is (L - H) / 16, uncompress(R, D, T), !.
search(CurrentBoard) :-
myHashEmpty(EmptyHash),
hash(CurrentBoard, CurrentBoardHash),
manhattan(CurrentBoard, CurrentBoardPriority),
compress(CurrentBoard, CurrentBoardCompressed),
myHashPut(EmptyHash, CurrentBoardCompressed, CurrentBoardHash, _, Enqueued),
search(CurrentBoard, CurrentBoardPriority, 0, Enqueued, []), !.
search(CurrentBoard, _, _, _, _) :-
manhattan(CurrentBoard, 0),
!.
search(CurrentBoard, CurrentBoardPriority, CurrentStep, Enqueued, Queue) :-
CurrentBoardPriority > 0,
moves(CurrentBoard, NextMoves),
update_enqueued_queue_all(Enqueued, Queue, NextMoves, CurrentStep, NextEnqueued, ImmediateQueue),
myHeapDeleteMin(ImmediateQueue, NextState, NextBoardPriority, NextQueue),
state(NextBoardCompressed, _, NextStep) = NextState,
uncompress(NextBoardCompressed, NextBoard),
search(NextBoard, NextBoardPriority, NextStep, NextEnqueued, NextQueue),
!.
update_enqueued_queue_all(Enqueued, Queue, [], _, Enqueued, Queue) :- !.
update_enqueued_queue_all(Enqueued, Queue, [Head|Tail], CurrentStep, NextEnqueued, NextQueue) :-
move(HeadBoard, HeadMove) = Head,
hash(HeadBoard, HeadHash),
compress(HeadBoard, HeadBoardCompressed),
update_enqueued_queue(Enqueued, Queue, HeadBoard, HeadBoardCompressed, HeadHash, HeadMove, CurrentStep, ImmediateEnqueued, ImmediateQueue),
update_enqueued_queue_all(ImmediateEnqueued, ImmediateQueue, Tail, CurrentStep, NextEnqueued, NextQueue),
!.
update_enqueued_queue(Enqueued, Queue, Board, BoardCompressed, BoardHash, Move, CurrentStep, NextEnqueued, NextQueue) :-
myHashGet(Enqueued, BoardCompressed, BoardHash, _), NextEnqueued = Enqueued, NextQueue = Queue, !;
NextStep is CurrentStep + 1, manhattan(Board, BoardHeuristic), BoardPriority is NextStep + BoardHeuristic, myHashPut(Enqueued, BoardCompressed, BoardHash, _, NextEnqueued), myHeapInsert(Queue, state(BoardCompressed, Move, NextStep), BoardPriority, NextQueue), !.
solve(X) :- flatten(X, Y), search(Y).
run :- hard(X), solve(X).
The code, as is, does not run to completion in a few minutes on my computer. I did a profile(run) with a reduced goal (e.g. stopping when the manhattan distance is 10), majority of the time is spent on garbage collection.
I have read about another thread on StackOverflow talking about the same thing, the 'solution' was to use the constraint library, that's something I cannot use.
I run out of my bag of tricks, frankly I am not a frequent Prolog programmer. Any idea how can I do better in term of speed?

How do I make this Prolog query work in a predicate?

I am trying to make this Prolog query:
placeRedBlocks(4, X), findall(Y, loopReplace(X, Y), A).
which outputs this:
A = [[r, r, r, b], [r, r, r, r], [b, r, r, r]],
X = [b, b, b, b]
work in the code if I only type in
placeRedBlocks(4, X).
The code I am using:
printList([ ]).
printList([H|T]) :- print(H), nl, printList(T).
placeRedBlocks(Length, List) :-
findall('b', between(1, Length, _), List).
replace([_|T], 0, X, [X|T]).
replace([H|T], I, X, [H|R]):-
I > -1,
NI is I-1,
% write([H|T]),
replace(T, NI, X, R), !.
% replace(L, _, _, L).
placeRedBlockUnit(A,_,0,_,A):- !.
placeRedBlockUnit(Line,Index,NumElm,Elm,NLine) :-
replace(Line,Index,Elm,BLine),
Index1 is Index+1,
NumElm1 is NumElm-1,
placeRedBlockUnit(BLine,Index1,NumElm1,Elm,NLine).
loopReplace(ListToReplace, NewList) :-
length(ListToReplace, Len),
TotalCount is Len-3,
between(0, TotalCount, Iterations),
between(3, Len, Size),
placeRedBlockUnit(ListToReplace, Iterations, Size, 'r', NewList).
Unfortunately, if I change placeRedBlocks to this it doesn't work.
placeRedBlocks(Length, List) :-
findall('b', between(1, Length, _), List),
findall(Y, loopReplace(List, Y), _).
and I only get:
X = [b, b, b, b]
What is happening here?
Is it possible for it to return back to the same list?

I realized that as long as I use a variable twice in a predicate I don't need to make it a parameter to my predicate.
Changing this
placeRedBlocks(Length, List) :-
findall('b', between(1, Length, _), List)
to this
placeRedBlocks(Length, List3) :-
findall('b', between(1, Length, _), List),
findall(Y, loopReplace(List, Y), List2),
append([List], List2, List3).
made me able to use the queries in the predicate while also keeping the predicate at 2 parameters.

Why doesn't it unify? Prolog issue

I'm trying to do a predicate in prolog which substitute the value I give to the variables of the polynomial and then it calculate the result. Here is my code:
as_monomial(X, m(X, 0, [])) :- number(X), !.
as_monomial(^(Y, Z), m(1, Z, [v(Z, Y)])) :- !.
as_monomial(*(X, ^(Y, Z)), m(G, K, Q)) :- as_monomial(X, m(G, TD, Vars)), K is (TD + Z), compress_monomial([v(Z, Y)| Vars], A), ordina_m(A, Q), !.
as_monomial(*(X, Y), m(G, K, Q)) :- as_monomial(X, m(G, TD, Vars)), K is (TD + 1), compress_monomial([v(1, Y)| Vars], A), ordina_m(A, Q), !.
as_monomial(-(X), m(-A, Y, L)) :- as_monomial(X, m(A, Y, L)).
as_monomial(X, m(1, 1, [v(1, X)])).
ordina_m(List, Sorted) :- sort(2, #=<, List, Sorted).
ordina_var(List, Sorted) :- sort(0, #=<, List, Sorted).
compress_monomial([], []) :- !.
compress_monomial([X| Xs], A2) :- compress_monomial(Xs, A), compress_monomial2(X, A, A2), !.
is_monomial(m(_C, TD, VPs)) :- integer(TD), TD >= 0, is_list(VPs).
is_polynomial(poly(M)) :- is_list(M), foreach(member(Monomio, M), is_monomial(Monomio)).
variables(Poly1, Result) :- is_polynomial(Poly1), variabili(Poly1, Result), !.
variables(Poly1, Result) :- as_polynomial(Poly1, Result1), variabili(Result1, Result), !.
variabili(poly([]), []) :- !.
variabili(poly([m(_, _, [])| Xs]), Ys) :- variabili(poly(Xs), Ys), !.
variabili(poly([m(X, Y, [v(_, A)| Vs])| Xs]), Z) :- variabili(poly([m(X, Y, Vs)| Xs]), Ys), ordina_var([A| Ys], R), compressV(R, Z), !.
compressV([], []).
compressV([X|T],[X|T1]):- member(X,T),!,canc(X,T,R), compressV(R,T1).
compressV([X|T],[X|T1]) :- compressV(T,T1).
canc(_L, [], []).
canc(L, [L|S], Z) :- canc(L, S, Z).
canc(L, [H|S], [H|Z]):- canc(L, S, Z), !.
as_polynomial(+(X, Y), poly(C)) :- as_monomial(Y, G), as_polynomial(X, poly(Gs)), compress_polynomial([G| Gs], C), !.
as_polynomial(-(X, Y), poly(C)) :- as_monomial(-Y, G), as_polynomial(X, poly(Gs)), compress_polynomial([G| Gs], C), !.
as_polynomial(X, poly([X])) :- is_monomial(X), !.
as_polynomial(X, poly([Q])) :- as_monomial(X, Q), !.
compress_polynomial([], []) :- !.
compress_polynomial([X| Xs], A2) :- compress_polynomial(Xs, A), compress_polynomial2(X, A, A2), !.
compress_polynomial2(m(X, Y, Z), [], [m(X, Y, Z)]) :- !.
compress_polynomial2(m(X, Y, Z), [m(X1, Y, Z)| Xs], [m(X2, Y, Z)| Xs]) :- X2 is (X + X1), !.
compress_polynomial2(X, [Y| Ys], [Y| Z]) :- compress_polynomial2(X, Ys, Z), !.
polyval(Poly1, V, Result) :- is_polynomial(Poly1), variables(Poly1, Vars), poly_val(Poly1, Vars, V, Result), !.
polyval(Poly1, V, Result) :- as_polynomial(Poly1, P1), variables(P1, Vars), poly_val(P1, Vars, V, Result), !.
poly_val(poly([]), , , poly([])) :- !.
poly_val(poly([m(X, Y, Z)| Xs]), Vars, V, poly([R| Ys])) :- poly_val(poly(Xs), Vars, V, poly(Ys)), print(m(X, Y, Z)), mon_val(m(X, Y, Z), Vars, V, R), !.
mon_val(m(X, Y, []), [_], [_], m(X, Y, [])) :- !.
mon_val(m(X, Y, [v(W, Z)| Vs]), [Z| Vs2], [Val| Vvs], m(X2, Y2, Z2)) :- integer(Val), mon_val(m(X, Y, Vs), Vs2, Vvs, m(X3, Y2, Z2)), X2 is (X3 * (Val ^ W)), !.
mon_val(m(X, Y, [v(W, Z)| Vs]), [_| Vs2], [_| Vvs], m(X, Y2, Z2)) :- mon_val(m(X, Y, [v(W, Z)| Vs]), Vs2, Vvs, m(X, Y3, Z2)), Y2 is (Y3 + W), !.
I hope I put all the code you need to prove it, in case please say it to me and I apologise for it. I know about the cut but, at the moment, it is just a trial. My problem is in mon_val because it looks like doesn't want to unify. An example of query I use is polyval(x+x+y, [1, 3], Q). where the output is "false" and it should return poly(m(1, 0, []), m(1, 0, []), m(3, 0, [])). Are you able to help me doing that? I just want to solve the problem and later I will also implement the sum between the numbers which is pretty easy with the rest of the code I have. Thanks guys

If you wanna know, at the end I solve the problem myself (which is, according some of you, the best way to learn and I'm agree). So my poly-val becomes:
polyval(Poly1, V, Result) :- is_polynomial(Poly1), variables(Poly1, Vars), poly_val(Poly1, Vars, V, Result), !.
polyval(Poly1, V, Result) :- as_polynomial(Poly1, P1), variables(P1, Vars), poly_val(P1, Vars, V, Result), !.
poly_val(poly([]), _, _, poly([])) :- !.
poly_val(poly([X| Xs]), Vars, V, poly(Z)) :- poly_val(poly(Xs), Vars, V, poly(Ys)), mon_val(X, Vars, V, R), compress_polynomial([R| Ys], Z), !.
/* mon_val(Monomio, Variabili, ValoreVariabili, Result) */
mon_val(m(X, _, []), [_], [_], m(X,0, [])) :- !.
mon_val(m(X, _, Z), [], [], m(X,0, Z)) :- !.
mon_val(m(X, Y, [v(W, Z) | R]), [Z| Vs], [Val|Vvs], m(X2, Y2, Z2)) :- integer(Val), mon_val(m(X, Y, R), Vs, Vvs, m(X3, Y2, Z2)), X2 is (X3 * (Val ^ W)), !.
mon_val(m(X, Y, Z), [_|Vs2], [_| Vvs], m(X2, Y2, A)) :- mon_val(m(X, Y, Z), Vs2, Vvs, m(X2, Y2, A)), !.`

delete some elements from a list

What I want to do is to delete part of a list specified in another list i.e. e.g.
?- deleteSome([1,4,3,3,2,2],[1,2,4],Z).
Z = [3,3,2].
I first defined the following. No problem there.
deleteOne(X, [X|Z], Z).
deleteOne(X, [V|Z], [V|Y]) :-
X \== V,
deleteOne(X,Z,Y).
Then, the following does not work as expected.
deleteSome([], [], _).
deleteSome([X|Xs], Y, Zs) :-
deleteSome(Xs, Y, [X|Zs]).
deleteSome([X|Xs], Y, Zs) :-
member(X,Y),
deleteOne(X,Y,Y),
deleteSome(Xs, Y, Zs).

I would use the powerful select/3 builtin
deleteSome(L, D, R) :-
select(E, L, L1),
select(E, D, D1),
!, deleteSome(L1, D1, R).
deleteSome(L, _, L).
test:
?- deleteSome([1,4,3,3,2,2],[1,2,4],Z).
Z = [3, 3, 2].

I must admit, I don't understand your deleteSome code at all. Here's what I'd do (no Prolog here, so might contain errors):
deleteSome(X, [], X).
deleteSome(X, [Y|Ys], Z) :-
deleteOne(Y, X, T),
deleteSome(T, Ys, Z).
I.e. If there's nothing to delete, no change. Otherwise, the result is when we delete the first of the to-deletes, and then delete the rest of them.
There is some confusion in that it seems your deleteOne has (Original, ToDelete, Result) parameters, but deleteSome has (ToDelete, Original, Result). For consistency, I'd rather rewrite it so the signatures are compatible:
deleteSome([], Y, Y).
deleteSome([X|Xs], Y, Z) :-
deleteOne(X, Y, T),
deleteSome(Xs, T, Z).

Resources