Related
I'm trying to move elements between Lists in LoL (list-of-list) structure.
I can figure out how to select the list and move the elements, but I'm lost on how to reconstruct the resulting LoL back.
Here is partial function :
move(From, To, State=[P1,P2,P3], NewState=[NP1, NP2, NP3]) :-
nth1(From, State, FL), nth1(To, State, TL), move_elem(FL, TL, NewFL, NewTL),
.....whats here?...
.. NewState should be build out of NewTL,NewFL and one of P1,P2,P3...
.. the order of the lists should be preserved..
move_elem/4 is implemented. From & To are integers and specify the lists-at-position that will participate in the move op.
Currently LoL is list of 3 lists, but I would like it in the future to parametrize the number of lists.
State is LoL before the move, NewState is the LoL after the move.
?- move_elem([1,2,3], [4,5,6], F,T).
F = [2, 3],
T = [1, 4, 5, 6].
nth1/3 seems to be working OK.
?- L=[[1,2],[3,4],[5,6]], nth1(2,L,El).
L = [[1, 2], [3, 4], [5, 6]],
El = [3, 4].
move() shold move element from one of the three lists to another.
From and To are the index-of-the-lists f.e.
LoL = [[1,2],[3,4],[5,6]]
move(1,3, LoL, NewLoL)
NewLoL = [[2],[3,4],[1,5,6]]
move(2,1, LoL, NewLoL)
NewLoL = [[3,1,2],[4],[1,5,6]]
move the top element from list-1 to list-3.
Using length/2 and append/3:
move(From, To, State, NewState):-
length([_|HState], From),
length([_|HNewState], To),
append(HState, [[Item|L]|TState], State),
append(HState, [L|TState], MState),
append(HNewState, [NL|TNewState], MState),
append(HNewState, [[Item|NL]|TNewState], NewState).
The idea is to use length/2 to produce a list on uninstantiated variables of length From-1 and another of length To-1 (thus we skip one element from the lists of length From and To).
Then append/3 can be used to split State in two parts or to concatenate two lists.
The first call to append will split State in a list HState of From-1 elements, and a second list with the rest. The first element from the rest is further split in two parts (the item to move and the rest of that element).
The second call to append joins the two parts excluding the item to be moved.
The third and fourth calls to append repeat this idea though this time they are used to add the moved item to the target location.
You can implement move/4 in this way:
appendHead(T,H,[H|T]).
removeHead([_|T],T).
insert(_,_,_,_,_,[],[]).
insert(C,I2,L1,L2,C,[_|TI],[L1|TO]):-
C1 is C+1,
insert(C,I2,L1,L2,C1,TI,TO).
insert(I1,C,L1,L2,C,[_|TI],[L2|TO]):-
C1 is C+1,
insert(I1,C,L1,L2,C1,TI,TO).
insert(I1,I2,L1,L2,C,[HI|TI],[HI|TO]):-
I1 \= C,
I2 \= C,
C1 is C+1,
insert(I1,I2,L1,L2,C1,TI,TO).
move(I1,I2,LIn,LOut):-
nth1(I1,LIn,L1),
nth1(I2,LIn,L2),
nth1(1,L1,E1),
removeHead(L1,L1R),
appendHead(L2,E1,L2F),
insert(I1,I2,L1R,L2F,1,LIn,LOut).
?- LoL = [[1,2],[3,4],[5,6]], move(1,3, LoL, NewLoL).
LoL = [[1, 2], [3, 4], [5, 6]],
NewLoL = [[2], [3, 4], [1, 5, 6]].
false.
?- LoL = [[2], [3, 4], [1, 5, 6]], move(2,1, LoL, NewLoL).
LoL = [[2], [3, 4], [1, 5, 6]],
NewLoL = [[3, 2], [4], [1, 5, 6]].
false.
?- LoL = [[1,2],[3,4],[5,6]], move(2,1, LoL, NewLoL).
NewLoL = [[3,1,2],[4],[1,5,6]].
false.
If you want to prevent backtracking, just add a cut ! after each definition of insert/4 (you will not get false).
Prolog does a depth-first search, meaning it will try to reach a goal by exploring all possible paths to a solution. Every time there are multiple paths available, it creates a choice point and then works its way down through the choices top to bottom. That means, if a choice immediately fails, the next will be called. This allows you to create the paths very clearly and you can give it choices to make. All atoms including lists are effectively immutable in Prolog. What you want to do is construct a second list from the first, possibly in a different order or with less elements, more elements, replaced elements etc.
I'm using replacement of a cell in a row with a cell(point(X,Y),Value) coordinate in a matrix as an example here. The three choices for rebuilding a list.
End of the list has been reached, this is the end condition and ends the new list.
The first cell of the list is checked and the coordinate doesn't match the replacement, so it's placed as is in the new list.
The first cell of the list does match the coordinate so place the element in the new list and close it off by adding the remaining unchecked elements as the tail.
This results in the code:
%coordinate not found, return the list as is
replace_cell(_,_,[],[]).
%no match, X already extracted from Element to reduce calls
replace_cell(X, Element, [RowElement|Tail], [RowElement|NewTail]) :-
RowElement \= cell(point(X,_),_),
replace_cell(X, Element, Tail, NewTail).
%match
replace_cell(X, Element, [cell(point(X,_),_)|Tail], [Element|Tail]).
This is the standard recursion you're probably used to. A goal is set, an answer is reached and Prolog starts stepping back through the calls made, filling in the variables we left open as it steps back. Then those filled variables become the output to the next returned call.
To then do it with multiple layers of lists, we just need to figure out which list we need to pass to the next, more specific call. In this matrix example, it's a square so all columns share an X and all rows share an Y coordinate. To figure out which row we need, we can feed the entire matrix into a simple predicate which checks the Y. Note that we aren't actually modifying the matrix yet, just identifying the row. This is mostly to keep the code readable.
%are there any rows left?
move_to_row(_, [], []).
%is element's Y equal to row Y?
move_to_row(Y, [Row|_], Row) :- Row = [cell(point(_,Y),_)|_].
%move to next row
move_to_row(Y,[_|Tail], Row) :- move_to_row(Y,Tail,Row).
After replacing the element in the row, since we have both the old and the new row we can identify the old row and reconstruct the matrix with the new row.
replaceElement(_,_,[],[]).
replaceElement(Replacable, Replacement, [Item|List], [Replacable|NewList] ) :-
Item \= Replacable,
replaceElement(Replacable, Replacement, List, NewList),
replaceElement(Replacable, Replacement, [Replacable|List], [Replacement|List] ) :-
!.
So effectively, the position in the list is kept by the order in which we step through the list on the way down, and then the new list is rebuilt on the way up.
For list [1,2,3], [Head|Tail] gives us Head = 1, Tail = [2,3]. If we then call [Head|Tail] again, it gives us Head = 2, Tail = [3]. On the way back, the exact opposite happens and the Head is appended to the front of the Tail. By visualizing each layer of lists as its own identifiable type and giving them their own identifier, it should be fairly simple to go through them efficiently irregardless of how many lists within lists you want to nest. The matrix is a 2d rectangle, but for example by having the coordinates within cell as a list and adding a Z axis it can fairly easily be turned into a cube or something even more complex with more than 3 dimensions.
I am having a bit of trouble with prolog as I have just started learning it. I am unsure how to test if X is the median of A, B, C. My first thought was to make a list of A, B, C and then sort it. I would then check if X is equal to the second number. The problem being that I don't know how to take three values and turn them into a list (If you can). Is this even the most effecent way to do this? Honestly I have no Idea so any insite would be helpful.
this is a very basic solution, with a sorting only accepting 3 values, but it should make the problem solved.
is_median_of_sorted([_, ValueToCheck, _],ValueToCheck).
sorted_list_of_3([A,B,C],R) :-
A>B, A>C, B>C, R = [A,B,C];
A>C, A>B, C>B, R = [A,C,B];
B>A, B>C, A>C, R = [B,A,C];
B>C, B>A, C>A, R = [B,C,A];
C>A, C>B, A>B, R = [C,A,B];
C>B, C>A, B>A, R = [C,B,A].
is_median_of_3(List, ValueToCheck) :-
sorted_list_of_3(List,SortedList),
is_median_of_sorted(SortedList, ValueToCheck).
To check it, query:
is_median_of_3([1,10,4],4).
Or if you want to check what is the median of a given list:
is_median_of_3([1,10,4],X).
You can also check it via browser at: https://swish.swi-prolog.org/p/three_values_median.pl
What is does is : is_median_of_3 first gets a matching sorted list, and then checks agains is_median_of_sorted, which just picks a 2nd element of the list.
Hope I could help.
If you want to create a modular program, you had to insert all the elements in a list, sort it and find the median. This could be done in this way:
findMedian([H|_],0,H):- !.
findMedian([_|T],C,X):-
C1 is C-1,
findMedian(T,C1,X).
median(L,X):-
msort(L,SortedL),
length(SortedL,Len),
Len2 is Len//2,
findMedian(SortedL,Len2,X).
?- median([1,10,4,5,7],X).
X = 5
?- median([1,10,4,5,7],5).
true
This solution will works also with list with an even number of elements, returning the element after the middle of the list (ex. 4 elements, [0,1,2,3], it returns 2). In this case you have to decide what to do (fail, return the two elements in the middle ecc...)
EDIT: as suggested in the comment, you should use msort/2 instead sort/2 because sort/2 removes duplicated elements.
I would choose a solution similar to #damianodamiano's, but I would find the middle element of a list without using length/2:
median(List, Median) :-
msort(List, SortedList),
middle_element(SortedList, SortedList, Median).
middle_element([], [M|_], M).
middle_element([_], [M|_], M).
middle_element([_,_|Xs], [_|Ys], M) :-
middle_element(Xs, Ys, M).
A simple answer to "check if X is the median of A,B,C?" is:
is_median_of_3(A,B,C,X):-
msort([A,B,C],[_,X,_]).
This will try to match if [A,B,C] sorted consists of any list (of three elements) with X as the middle element.
I don't know everywhere, but in swish there are residuals coming out from msort as such:
msort([2,8,4],L).
L = [2, 4, 8],
_residuals = []
L = [2, 4, 8],
_residuals = [_1080]
L = [2, 4, 8],
_residuals = [_1122, _1128]
L = [2, 4, 8],
_residuals = [_1170, _1176, _1182]
L = [2, 4, 8],
_residuals = [_1224, _1230, _1236, _1242]
L = [2, 4, 8],
_residuals = [_1284, _1290, _1296, _1302, _1308]
L = [2, 4, 8],
_residuals = [_716, _722, _728, _734, _740, _746]
L = [2, 4, 8],
_residuals = [_788, _794, _800, _806, _812, _818, _824]
L = [2, 4, 8],
_residuals = [_866, _872, _878, _884, _890, _896, _902, _908]
and so on...
Also, I couldn't test it in tutorialspoint because it seems broken.
Following a generate & test approach you can write:
median(List,Median) :-
dif(List,[]), msort(List,SList), length(List,Len),
append(Low,[Median],Tmp), append(Tmp,High,SList),
length(Low,LowLen), div(Len,2)=:=LowLen, !.
This has a convenient declarative reading: Median is the value of a non-empty List that splits the sorted version SList of List into two halves Low and High, viz. Median is the "middle element" of the distribution of the values in List.
Indeed, the program above determines Median by checking whether SList can be written as a list concatenation Low + [Median] + High such that the length of Low is half the length of SList. Since High is never used (i.e. it is a singleton), the program can be rewritten by substituting it with _ as in:
median(List,Median) :-
dif(List,[]), msort(List,SList), length(List,Len),
append(Low,[Median],Tmp), append(Tmp,_,SList),
length(Low,LowLen), div(Len,2)=:=LowLen, !.
Naturally, it is also possible to distinguish the case in which the length of the list is odd from the case it is even, so to return the average of the two median elements in the latter case:
median(List,Median) :-
is_list(List), dif(List,[]),
msort(List,SList), length(List,Len),
median(SList,Len,Median).
median(SList,Len,Median) :-
Len mod 2 =:= 1,
append3(Low,[Median],_,SList),
length(Low,LowLen), div(Len,2)=:=LowLen, !.
median(SList,Len,Median) :-
Len mod 2 =:= 0,
append3(Low,[M1,M2],_,SList),
length(Low,LowLen), div(Len,2)=:=LowLen + 1,
Median is (M1+M2)/2, !.
append3(L1,L2,L3,L) :- append(L1,L2,T), append(T,L3,L).
I've been trying to solve this problem for quite sometime and I think the logic I'm attempting is flawed.
The objective is to replace a subsequently decreasing sublist of numbers by the last of the sublist.
?- compare([1, 3, 7, 6, 5, 10, 9], Result).
Result = [1, 3, 5, 9] ;
false.
What I tried was:
compare([A,B|T],X):-
%succ(B,A),
A is B+1,
append([],NextX,X),
compare([B|T],NextX).
remove([A,B|T],X):-
A=\=B+1,
compare([B|T],X).
I'm not certain how to write the base case for the compare/2 and I think the I'm not correctly converting my logic into the code. What I'm trying here is to compare A and B and drop A from the list if they are successive numbers.
Your help is very much appreciated.
You are almost there. First cover the special case: If the list contains only one element it is in the list.
compare([X],[X]).
your second rule just needs little altering:
compare([A,B|T],X):- % A is not in the list if
A is B+1, % A = B+1
compare([B|T],X). % Note: X is the same as in head of rule
Your predicate remove/2 is should be the 3rd rule of compare/2 covering the alternative case:
compare([A,B|T],[A|X]):- % A is in the list
A=\=B+1, % if A is not B+1
compare([B|T],X).
Now the query works:
?- compare([1, 3, 7, 6, 5, 10, 9], Result).
Result = [1,3,5,9] ?
yes
However, this predicate only works if the first list is variable free. You can't use it the other way round:
?- compare([A,B,C], [1,2]).
ERROR at clause 2 of user:compare/2 !!
INSTANTIATION ERROR- X is A+B: expected bound value
If you use library(clpfd) on the other hand ...
:- use_module(library(clpfd)).
compare([X],[X]).
compare([A,B|T],X):-
A #= B+1,
compare([B|T],X).
compare([A,B|T],[A|X]):-
A #\= B+1,
compare([B|T],X).
... the above query works too:
?- compare([A,B,C], [1,2]).
A = C = 2,
B = 1 ? ;
A = 1,
B = 3,
C = 2 ? ;
no
Hi all im new to programming and im doing a problem for learning and enjoyment. Im a bit stuck at this point.. The problem is from Introduction to Programming using Sml 5.9
I want to split a list of [x1, x2, x3, ... ,xn] = ([x1, x3,....], [x2, x4,...])
This is what I have made so far:
fun split [] = []
| split (x1::x2::x3::x4::xs) = ([x1, x3], [x2, x4])::split xs
val test1split = split [1, 1, 2, 3];
From this I get:
[([1, 2], [1, 3])].... (I want a tuple with splitting list and not this obviously)
If there are more than 4 elements then the function doesn't work. Maybe I need a helper function to sort even and odd elements in a list first? I hope someone can help me with tracking my mind in the correct direction, until then I keep trying.
fun split [] = ([], [])
| split [x] = ([x], [])
| split (x1::x2::xs) =
let
val (ys, zs) = split xs
in
((x1::ys), (x2::zs))
end;
val test1split = split [1, 1, 2, 3, 5, 6] = ([1, 2, 5], [1, 3, 6])
val test2split = split [8, 7, 6, 5, 4, 3] = ([8, 6, 4], [7, 5, 3])
val test3split = split [8, 7] = ([8], [7])
val test4split = split [8] = ([8], [])
Solved it... Not completely sure how lol, need alot more practice to master it. Couldn't have done it without the pointers... Thx alot for the help Nick Barnes.
I'll try not to give too much away, but here are some tips:
You need two base cases - one for [], one for [x].
Your general case only needs to deal with two elements, not four (putting one in the first list, and one in the second)
At the moment, you've got split returning a list, rather than a tuple. The result of your first base case should be ([],[]).
In the general case, the recursive split xs will return a tuple (ys,zs). You need to extract these values, and build the resulting tuple in terms of ys, zs, x1 and x2.
(Edit) A couple of points on your revised solution:
You only need to deal with two elements at a time - the general case should be split x1::x2::xs
split [x,y] is handled by the general case - no need for another base case.
You're missing the recursive call! Elements are ending up in both lists because you're putting xs directly into both halves of your output - you need to split it first. Start with
let (ys, zs) = split xs in ...
In Mathematica I have a list:
x = {1,2,3,3,4,5,5,6}
How will I make a list with the duplicates? Like:
{3,5}
I have been looking at Lists as Sets, if there is something like Except[] for lists, so I could do:
unique = Union[x]
duplicates = MyExcept[x,unique]
(Of course, if the x would have more than two duplicates - say, {1,2,2,2,3,4,4}, there the output would be {2,2,4}, but additional Union[] would solve this.)
But there wasn't anything like that (if I did understand all the functions there well).
So, how to do that?
Lots of ways to do list extraction like this; here's the first thing that came to my mind:
Part[Select[Tally#x, Part[#, 2] > 1 &], All, 1]
Or, more readably in pieces:
Tally#x
Select[%, Part[#, 2] > 1 &]
Part[%, All, 1]
which gives, respectively,
{{1, 1}, {2, 1}, {3, 2}, {4, 1}, {5, 2}, {6, 1}}
{{3, 2}, {5, 2}}
{3, 5}
Perhaps you can think of a more efficient (in time or code space) way :)
By the way, if the list is unsorted then you need run Sort on it first before this will work.
Here's a way to do it in a single pass through the list:
collectDups[l_] := Block[{i}, i[n_]:= (i[n] = n; Unevaluated#Sequence[]); i /# l]
For example:
collectDups[{1, 1, 6, 1, 3, 4, 4, 5, 4, 4, 2, 2}] --> {1, 1, 4, 4, 4, 2}
If you want the list of unique duplicates -- {1, 4, 2} -- then wrap the above in DeleteDuplicates, which is another single pass through the list (Union is less efficient as it also sorts the result).
collectDups[l_] :=
DeleteDuplicates#Block[{i}, i[n_]:= (i[n] = n; Unevaluated#Sequence[]); i /# l]
Will Robertson's solution is probably better just because it's more straightforward, but I think if you wanted to eek out more speed, this should win. But if you cared about that, you wouldn't be programming in Mathematica! :)
Here are several faster variations of the Tally method.
f4 uses "tricks" given by Carl Woll and Oliver Ruebenkoenig on MathGroup.
f2 = Tally## /. {{_, 1} :> Sequence[], {a_, _} :> a} &;
f3 = Pick[#, Unitize[#2 - 1], 1] & ## Transpose#Tally## &;
f4 = # ~Extract~ SparseArray[Unitize[#2 - 1]]["NonzeroPositions"] & ## Transpose#Tally## &;
Speed comparison (f1 included for reference)
a = RandomInteger[100000, 25000];
f1 = Part[Select[Tally##, Part[#, 2] > 1 &], All, 1] &;
First#Timing#Do[##a, {50}] & /# {f1, f2, f3, f4, Tally}
SameQ ## (##a &) /# {f1, f2, f3, f4}
Out[]= {3.188, 1.296, 0.719, 0.375, 0.36}
Out[]= True
It is amazing to me that f4 has almost no overhead relative to a pure Tally!
Using a solution like dreeves, but only returning a single instance of each duplicated element, is a bit on the tricky side. One way of doing it is as follows:
collectDups1[l_] :=
Module[{i, j},
i[n_] := (i[n] := j[n]; Unevaluated#Sequence[]);
j[n_] := (j[n] = Unevaluated#Sequence[]; n);
i /# l];
This doesn't precisely match the output produced by Will Robertson's (IMO superior) solution, because elements will appear in the returned list in the order that it can be determined that they're duplicates. I'm not sure if it really can be done in a single pass, all the ways I can think of involve, in effect, at least two passes, although one might only be over the duplicated elements.
Here is a version of Robertson's answer that uses 100% "postfix notation" for function calls.
identifyDuplicates[list_List, test_:SameQ] :=
list //
Tally[#, test] & //
Select[#, #[[2]] > 1 &] & //
Map[#[[1]] &, #] &
Mathematica's // is similar to the dot for method calls in other languages. For instance, if this were written in C# / LINQ style, it would resemble
list.Tally(test).Where(x => x[2] > 1).Select(x => x[1])
Note that C#'s Where is like MMA's Select, and C#'s Select is like MMA's Map.
EDIT: added optional test function argument, defaulting to SameQ.
EDIT: here is a version that addresses my comment below & reports all the equivalents in a group given a projector function that produces a value such that elements of the list are considered equivalent if the value is equal. This essentially finds equivalence classes longer than a given size:
reportDuplicateClusters[list_List, projector_: (# &),
minimumClusterSize_: 2] :=
GatherBy[list, projector] //
Select[#, Length## >= minimumClusterSize &] &
Here is a sample that checks pairs of integers on their first elements, considering two pairs equivalent if their first elements are equal
reportDuplicateClusters[RandomInteger[10, {10, 2}], #[[1]] &]
This thread seems old, but I've had to solve this myself.
This is kind of crude, but does this do it?
Union[Select[Table[If[tt[[n]] == tt[[n + 1]], tt[[n]], ""], {n, Length[tt] - 1}], IntegerQ]]
Given a list A,
get the non-duplicate values in B
B = DeleteDuplicates[A]
get the duplicate values in C
C = Complement[A,B]
get the non-duplicate values from the duplicate list in D
D = DeleteDuplicates[C]
So for your example:
A = 1, 2, 2, 2, 3, 4, 4
B = 1, 2, 3, 4
C = 2, 2, 4
D = 2, 4
so your answer would be DeleteDuplicates[Complement[x,DeleteDuplicates[x]]] where x is your list. I don't know mathematica, so the syntax may or may not be perfect here. Just going by the docs on the page you linked to.
Another short possibility is
Last /# Select[Gather[x], Length[#] > 1 &]