7
$\begingroup$

Small is a relative concept for human. Sometimes $0.1$ is small, such as in {0.1,2,4,5}. sometime $100$ also is small,such as in {100,10000,10050,22366}. I want to delete those small number.

For example, I have such list

list={1, 1, 4, 1, 1433, 5, 33, 5, 1605, 2, 1563, 2, 303, 6, 1, 3, 1689, 2, 
71, 1552, 1, 1615, 1, 4, 1, 1, 1, 1, 946, 1, 1, 161, 1, 3, 1, 78, 2, 
1, 35, 1303, 4, 5, 302, 229, 1, 1, 3, 7, 16, 1, 1, 3, 3, 1693, 1, 1, 
1, 1409, 433, 2, 1, 1, 21, 3, 1, 1582, 3, 1, 159, 10, 2, 1, 1, 2, 13, 
559, 2, 1, 3, 231, 1, 1, 299, 1, 1109, 12, 555, 2, 2, 1331, 1, 1, 15, 
1674, 3, 47, 1452, 248, 3, 1238, 3, 1, 1576, 3, 2, 2, 1, 8, 1, 6, 1, 
1, 20, 2, 1, 1, 1, 1, 1, 2, 1406, 1, 1248, 9, 3, 1, 3, 1, 795, 1609, 
41, 1, 341, 1, 4, 3, 2, 3, 1, 692, 1, 1, 829, 1, 405, 3, 11, 459, 2, 
3, 11, 1, 1, 6, 67, 1, 85, 1, 63}

We can visualize it

BarChart[Sort[list]]

As our eyes see, there is a obvious step in the bar chart. I think those values below the first step is small. How to delete it by a automatica threshold?


Such as, our DeleteSmallComponents always will help us define what is SMALL

$\endgroup$
8
  • 1
    $\begingroup$ Maybe tol = 0.05; Pick[list, Thread[#/Max[#] > tol] &[Abs[list]]] which is idempotent. $\endgroup$ – Coolwater Oct 15 '17 at 16:58
  • 4
    $\begingroup$ What's to distinguish the step you've highlighted from other, larger steps in the graph? (E.g., the some around 500 and 1000.) $\endgroup$ – jjc385 Oct 15 '17 at 17:00
  • $\begingroup$ @jjc385 Hard to define, but that step is obvious indeed,is not? $\endgroup$ – yode Oct 15 '17 at 20:03
  • 8
    $\begingroup$ "Obvious" is just as much a subjective concept for a human as "small" and therefore similarly affected by each individual's life experience. Which makes your question more a matter of psychology than mathematics. $\endgroup$ – m_goldberg Oct 15 '17 at 20:16
  • $\begingroup$ @m_goldberg Then DeleteSmallComponents are doing sone psychology thing but not for image processing or other something..:) $\endgroup$ – yode Oct 15 '17 at 21:02
17
$\begingroup$

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:

Mathematica graphics

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", "neighborhood contraction", and "mean shift" were all able to capture exactly the group of elements that you want to delete. This suggests that you could make use of one of these methods by deleting the leftmost cluster. The other clustering methods almost selected the desired elements. For two of them, one would have to delete the two leftmost clusters. "Gaussian mixture" selected a few more values than desired.

The code to create a visualization like the ones above is this:

list = Sort[list];
colors[clusters_] := Flatten@MapIndexed[
    ConstantArray[ColorData[97, First[#2]], Length[#]] &,
    SortBy[clusters, Mean]
    ];
clusters = FindClusters[list];
pl1 = BarChart[list, ChartStyle -> colors[clusters], PlotLabel -> "Default"]

Finally, here is a graph-based implementation of using a threshold to detect the jump:

cutoff = 20;
distances = EuclideanDistance @@@ Partition[list, 2, 1];
edges = UndirectedEdge @@@ Partition[Range[Length[list]], 2, 1];
edges = Pick[edges, UnitStep[distances - cutoff], 0];
clusters = ConnectedComponents[edges];

BarChart[list, ChartStyle -> colors[clusters], PlotLabel -> "Connected components"]

Mathematica graphics

This is not the most straightforward way to implement a threshold in one dimension, but I did it in this way to share this clustering algorithm which I myself learned recently by word-of-mouth. I quite like it, but I would normally only implement it like this for higher dimensions.

$\endgroup$
1
  • $\begingroup$ Thanks very much, It is a very usefull answer.. $\endgroup$ – yode Oct 17 '17 at 2:52
1
$\begingroup$

After some days to understand, I think the FindThreshold[list, Method -> "Cluster"] is what I really after. Then those value less than this threshold is real small by Otsu's method

BarChart[Sort /@ Function[fun, Select[list, 
     fun[#, FindThreshold[list, Method -> "Cluster"]] &]] /@ {Less, Greater}]

ps: But it don't find the first prominent step..

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.