Suppose I have a list:
l={{1,4},{2,4},{3,5},{4,6},{5,3},{6,2}}
How can I select the elements of the list in the second element is decreasing and first element of the list increasing? That is, I want {{1,4},{2,4},{5,3},{6,2}?
I know there is a simple function in Mathematica to do this. But I cannot find it.
If your input list is already sorted by the first column:
LongestOrderedSequence[l, #[[2]] >= #2[[2]] &]
{{1, 4}, {2, 4}, {5, 3}, {6, 2}}
In general, for arbitrary list of pairs not necessarily sorted by the first column:
LongestOrderedSequence[l, And[#[[1]] <= #2[[1]], #[[2]] >= #2[[2]]] &]
{{1, 4}, {2, 4}, {5, 3}, {6, 2}}
Version 10.1 doesn't have LongestOrderedSequence. For the sorted case I might therefore use:
Reap[ Fold[If[#2[[2]] > #, #, Sow[#2][[2]]] &, ∞, l] ][[2, 1]]
{{1, 4}, {2, 4}, {5, 3}, {6, 2}}
Compiled function for better performance:
Compile[{{a, _Integer, 2}},
Module[{list = Internal`Bag[Rest[{0}], 2]},
Fold[If[#2[[2]] > #, #, Internal`StuffBag[list, #2, 2]; #2[[2]]] &, a[[1, 2]], a];
Internal`BagPart[list, All] ~Partition~ 2
]
];
I hope nobody minds me practicing. The idea is to take differences between sequential elements and apply an If step according to the sign.
Here is an ugly and dirty way to do it with Table. I need Prepend because g does not work for the first element in l, which is always in the result. I then delete redundant cases (zeros).
l = {{1, 4}, {2, 4}, {3, 5}, {4, 6}, {5, 3}, {6, 2}}
g[t_] := l[[t - 1]] - l[[t]]
DeleteCases[
Prepend[Table[
If[g[t][[1]] >= 0; g[t][[2]] <= 0, l[[t]], 0], {t, 2, Length[l]}],
l[[1]]], 0]
Same thing using a Do loop (avoids redundant cases) and repartitioning l by applying a function that gives the differences. They are then fed in the loop.
l = {{1, 4}, {2, 4}, {3, 5}, {4, 6}, {5, 3}, {6, 2}}
res := {}
h[x_, y_] := {x - y}
elem = Flatten /@ Partition[l, 2, 1, {1, -1}, {}, h]
{{-1, 0}, {-1, -1}, {-1, -1}, {-1, 3}, {-1, 1}}
res = Append[res, l[[1]]]; Do[
If[elem[[i, 1]] >= 0; elem[[i, 2]] <= 0,
res = Append[res, l[[i + 1]]],], {i, 1, Length[l] - 1}]
Annoyingly I cannot make Do work from i=2 instead of 1, which would simplify even further.
In both cases the output is
{{1, 4}, {2, 4}, {5, 3}, {6, 2}}
If ordered by first column:
list = {{1, 4}, {2, 4}, {3, 5}, {4, 6}, {5, 3}, {6, 2}};
DeleteDuplicates[list, #1[[2]] < #2[[2]] &]
{{1, 4}, {2, 4}, {5, 3}, {6, 2}}
Using SequenceReplace:
l = {{1, 4}, {2, 4}, {3, 5}, {4, 6}, {5, 3}, {6, 2}};
SequenceReplace[l, {{a_, b_}, {c_, d_}} ->
If[a > c || b < d, Nothing, Sequence @@ {{a, b}, {c, d}}]]
{{1, 4}, {2, 4}, {5, 3}, {6, 2}}
