38
You could try BilateralFilter:
ListLinePlot[{data,
BilateralFilter[data, 2, .5, MaxIterations -> 25]},
PlotStyle -> {Thin, Red}]
Or alternatively, MeanShiftFilter can produce similar results:
ListLinePlot[{data,
MeanShiftFilter[data, 5, .5, MaxIterations -> 10]},
PlotStyle -> {Thin, Red}]
Third alternative, as mentioned by @Xavier ...
34
Please look up Part and Span.
You can use
data[[ ;; ;; n]]
28
Perhaps one of the simplest ways is to use Tally:
p = {1, 2, 4, 4, 6, 7, 8, 8};
Cases[Tally @ p, {x_, n_ /; n > 1} :> x]
{4, 8}
A somewhat faster formulation:
Pick[#, Unitize[#2 - 1], 1] & @@ Transpose[Tally @ p]
Taking the optimization to a rather excessive degree:
#[[SparseArray[#2, Automatic, 1]["AdjacencyLists"]]] & @@ Transpose[...
28
res1 = Select[coordinates, #[[1]] > 6 && #[[1]] < 7 &]; //
AbsoluteTiming // First
6.997629
res2 = Select[coordinates, 6 < #[[1]] < 7 &]; // AbsoluteTiming // First
4.676356
res3 = Pick[coordinates, 6 < # < 7 & /@ coordinates[[All, 1]]]; //
AbsoluteTiming // First
5.266651
res4 = Pick[coordinates, (1 - ...
26
The following code will filter noisy data…
SGKernel[left_?NonNegative, right_?NonNegative, degree_?NonNegative, derivative_? NonNegative] :=
Module[{i, j, k, l, matrix, vector},
matrix = Table[ (* matrix is symmetric *)
l = i + j;
If[l == 0,
left + right + 1,
(*Else*)
Sum[k^l, {k, -left, right}]
],...
23
New proposal
I was thinking about this problem today and came up with a new approach. In testing it appears to be competitively fast, often notably faster than any other method yet posted. It is also quite clean.
A limitation shared with rasher's uc: all elements in the drop list must be present in the main list.
fastRF[a_List, b_List] :=
Module[{c, o,...
22
I will give you two similar methods. But, I will rewrite one of the comments above just to make sure it is read.
You've been given some fine answers, but be absolutely sure that removing the outliers is Doing The Right Thing™. You might want to consider "robust" methods that can deal with the presence of outliers. – Guess who it is.
Simple ...
22
Here is a test list:
lst = {{1, 2}, {1, 2}, {3, 4}, {5, 6}, {5, 6}, {7, 8}}
Here is one way then:
GroupBy[Tally[lst], Last][1][[All, 1]]
(* {{3, 4}, {7, 8}} *)
The same idea using purely associations:
Keys[GroupBy[Counts[lst], Identity][1]]
(* {{3, 4}, {7, 8}} *)
A somewhat more efficient method can be this:
Pick[lst, Lookup[Counts[lst], lst], 1]
(*...
22
You can use the usual UnitStep + Total tricks:
r1 = Table[Total[UnitStep[m-s]], {m,10000}]; //AbsoluteTiming
r2 = Table[Length@Select[s,LessEqualThan[m]],{m,10000}];//AbsoluteTiming
r1 === r2
{0.435358, Null}
{41.4357, Null}
True
Update
As @J42161217 points out, you can take advantage of the fact that the data is sorted to speed things up. ...
21
The question title poses a good question, although the question formulation is somewhat specialized and misplaced (as mentioned in a comment).
This answer provides data and a method description answering:
How to find outliers in 3D numerical data?
Data
It order to provide a good answer it would be better to use "real life" data. Not spending much time ...
21
DeleteDuplicates[lines, RegionWithin]
{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}
Also
DeleteDuplicates[lines, MemberQ[{##}, RegionIntersection @ ##]&]
{InfiniteLine[{{0, 0}, {1, 0}}], InfiniteLine[{{0, 1}, {1, 0}}]}
21
I think you'll find this faster:
dd[list_, n_] :=
Module[{pi = Flatten[Values[PositionIndex[list][[All, ;; UpTo@n]]]]},
list[[Sort@pi]]];
Using RandomInteger[20000, 20000] as a test list and allowing 3 duplicates, your code took ~37 seconds, this needed ~0.03 seconds.
Comparable in speed, simpler:
dd2[list_, n_] :=
list[[Union @@
GatherBy[...
20
ReplaceRepeated is fine for short lists but it will get very slow if the list is long, because it starts over from the beginning of the list after each replacement. A better approach is to start the next replacement after the point of the previous one. One implementation of that:
fn1 = # /.
{a___, aa_Symbol, _Integer, bb_Symbol, b___} :>
...
20
You could take a look at the built-in functions FindAnomalies and DeleteAnomalies.
We can use LearnDistribution on the MovingMedian of the data to get an idea of what data we would expect, and then use DeleteAnomalies.
ListPlot[DeleteAnomalies[
LearnDistribution[MovingMedian[Data, 5], Method -> "Multinormal"],
Data], PlotRange -> Full]
...
19
You may use Tally to finish the task as follows:
Cases[Tally[list], {x_, 4} :> x]
the result will be {a,b}.
19
I would suggest using a median filter with small radius to eliminate the large spikes, then a mean filter to smooth the remaining signal. @Xavier essentially combines these two filters by using TrimmedMean.
Other than the large spikes, your data seem to have a strong signal with a period of about 10 points. You could use BandstopFilter to remove this, or ...
19
Try
testList //. {a___, aa_Symbol, _Integer, bb_Symbol, b___} :> {a, aa, bb, b}
{a, b, c, 4, 5, d, e, f, g, 4}
% == resultList
True
Note that I replaced __ (BlankSequence) with ___ (BlankNullSequence), so this will work for an integer which appears as the second element in the list.
19
Slightly faster than @kglr's solution is to use Clip:
SeedRandom[1];
coordinates = RandomReal[10, {4000000, 3}];
r1 = Pick[
coordinates,
Unitize @ Clip[coordinates[[All,1]], {6, 7}, {0, 0}],
1
];//RepeatedTiming
r2 = Pick[
coordinates,
(1-UnitStep[#-7]) (1-UnitStep[6-#])&@coordinates[[All,1]],
1
];//RepeatedTiming
r1 === r2
...
18
A fast uncompiled alternative without pattern matching is to use the NonzeroPositions property of SparseArray, as long as you're dealing with numerical data.
list = RandomInteger[{1, 100}, 10^7];
SparseArray[Unitize[list - Max[list]] - 1]["NonzeroPositions"]; // RepeatedTiming
(* 0.0855 *)
Position[list, Max[list]] // RepeatedTiming
(* 0.509 *)
compPos[...
18
Mr.Wizard inspired me to improve. While his recursive approach is elegant, the problem clearly can be done linearly. Indeed:
jjc2 = (
Sow@First@#;
BlockMap[
If[ ! MatchQ[#, {_Symbol, _Integer, _Symbol}], Sow@#[[2]] ]; &,
#, 3, 1 ];
Sow@Last@big;
// Reap
// Last@*Last
) &
(r1=jjc2@big); // AbsoluteTiming
{0....
17
You can also use FilterRules:
rule = {beta -> 4, alpha -> 2, x -> 4, z -> 2, w -> 0.8};
FilterRules[rule, beta]
(* {beta -> 4} *)
FilterRules[rule, {beta, alpha}]
(* {beta -> 4, alpha -> 2} *)
Update: additional alternatives if you have V10:
KeyTake[rule,{alpha, x}]
(* or *) KeyTake[{alpha,x}][rule]
(* <|alpha->2,x->4|&...
17
For a 1D list you can also use
Pick[Range@Length@list, list, Max@list]
17
Original Answer
A good question to ask is: are these image processing filters or signal processing filters?
If we take a signal processing viewpoint then it is useful to look at the impulse response function. First we make an impulse and then use your filters
imp = ConstantArray[0, 1024]; imp[[512]] = 1;
impR = {
LowpassFilter[HighpassFilter[#, 0.01],...
17
Time increases enormously with ParallelMap, because
rlp = Partition[rl, 4];
produces 2500000 sublists of four elements each. Instead, use
rlp = Partition[rl, 2500000];
to produce four sublists of 2500000 elements each.
Also, note that the results of ParallelMap should be combined by
ParallelMap[Select[#, PrimeQ] &, rlp] // Flatten
to achieve the ...
17
img = Import["https://i.stack.imgur.com/YsIVf.png"];
img2 = Pruning @ Thinning @ Closing[#, 10]& @ DeleteSmallComponents[#, 25000]& @
LocalAdaptiveBinarize[#, 50]& @ GaussianFilter[#, 10]& @ img
HighlightImage[img, img2]
17
DeleteDuplicatesBy[Sort][squareNumbers]
DeleteDuplicatesBy[ReverseSort][squareNumbers] (* thanks: @Sascha *)
DeleteDuplicatesBy[squareNumbers, Sort]
DeleteCases[squareNumbers, {x_, y_} /; x > y]
DeleteCases[squareNumbers, _?(Not[OrderedQ@#] &)]
Select[squareNumbers, OrderedQ]
Select[allPossiblePairs, OrderedQ @ # && squareNumberQ @ # &]
...
17
We can turn to unsupervised machine learning in the form of clustering algorithms to try to automate this intuition. Here are a few different results using FindClusters with different methods:
Some of these methods are stochastic so the result may vary from realization to realization, but at least in this particular realization, we see that "default", "...
16
When applied to string patterns Except only seems to work for string patterns that represent classes of characters or for string patterns that represent positions in strings, e.g.:
Except[{"A" | "B"}]
Except[WordCharacter]
Except[StartOfLine]
If you apply Except to an arbitrary String pattern (i.e., the head is StringExpression), the resulting expression ...
16
The following should work:
lis = {{1, 2, 3, 4, 5, 6}, {1, 9, , 4, 6, 2}, {4, a, 3, 7, 1, 2},
{3.4, 5.2, 6.5, 7.7, 6.1, 2}};
Then:
Cases[lis, {__?NumericQ}]
{{1, 2, 3, 4, 5, 6}, {3.4, 5.2, 6.5, 7.7, 6.1, 2}}
We can also use VectorQ with Select
Select[lis, VectorQ[#, NumericQ] &]
If you have Version 10, the following works:
Select[lis, ...
16
Avoiding Sort makes it a bit faster
list = "a" <> ToString[#] & /@ Range[10000];
n = 4567;
m1 := list[[Sort@RandomSample[Range@Length@list, n]]]
m2 := SortBy[RandomSample[list, n], PositionIndex[list]]
m3 := Pick[list, RandomSample[Join[ConstantArray[0, n],
ConstantArray[1, Length[list] - n]]], 0]
m1; // ...
Only top voted, non community-wiki answers of a minimum length are eligible