COMPGROUPS.NET | Search | Post Question | Groups | Stream | About | Register

### programming problem about elements taken

• Email
• Follow

Dear all,
I have a list of numbers (A),in fact, they are numbers distributed
over [0,1].  Given parameter \epsilon, I have to choose elements from A
such that their distances are larger than \epsilon, so the elements are
"distringuishable". My goal is to find the maximum number of elements
from A to meet the above "distinct criterion".
How to do it with the functions build-in in mathematica ??


 0
Reply GRseminar (9) 12/30/2006 10:28:13 AM

See related articles to this posting

Barrow schrieb:
> Dear all,
>   I have a list of numbers (A),in fact, they are numbers distributed
> over [0,1].  Given parameter \epsilon, I have to choose elements from A
> such that their distances are larger than \epsilon, so the elements are
> "distringuishable". My goal is to find the maximum number of elements
> from A to meet the above "distinct criterion".
>   How to do it with the functions build-in in mathematica ??
>   Thanks in advence.           Sincerely           Barrow
>

Hi Barrow,

the first method coming to my mind has been the use of ReplaceRepeated, but
for long lists this lasts far too long:

A=Table[Random[],{2000}];
epsilon=1.*^-4;

Timing[Length[
r1=A//.{x___,c_,y___}/;Min[Abs[c-{x,y}]]<epsilon:>{x,y}
]]

--> {22.125 Second,1650}

It is sufficient to compare element k with elements k+1,...,n:

selectDistinguishable[a_List,eps_]:=
Pick[a,Min[Abs[a[[#]]-Drop[a,#]]]>eps&/@Range[Length[a]]]

Timing[Length[
r2=selectDistinguishable[A,epsilon]
]]

--> {0.11 Second,1650}

_Much_ better :-)

r1===r2
--> True

hth,
Peter


 0
Reply petsie (836) 12/31/2006 10:11:02 AM

Barrow,

It's not completely clear what your grouping criterion is. After all, the
skull bone is connected to the toe bone but they are quite far apart.

I'm going to use a criterion of sorting all the numbers and then splitting
them into groups whenever there is a gap greater than or equal to epsilon.

Here is a test set.

testset = Table[Random[], {20}]
{0.854031, 0.1915, 0.671011, 0.875499, 0.0538857, 0.420417, 0.0711807,
0.240185, 0.672597, 0.0146134, 0.640515, 0.790636, 0.742558, 0.540169,
0.136822, 0.0476439, 0.725082, 0.482359, 0.414704, 0.411541}

We sort the testset.

step1 = Sort[testset]
{0.0146134, 0.0476439, 0.0538857, 0.0711807, 0.136822, 0.1915, 0.240185,
0.411541, 0.414704, 0.420417, 0.482359, 0.540169, 0.640515, 0.671011,
0.672597, 0.725082, 0.742558, 0.790636, 0.854031, 0.875499}

Pick an epsilon of 1/4 the maximum gap.

epsilon = Max[step2]/4
0.075833

Now use the Split command to group numbers whenever the gap is less than
epsilon.

Split[step1, #2 - #1 < epsilon &]
Length[%]
{{0.0146134, 0.0476439, 0.0538857, 0.0711807, 0.136822, 0.1915,
0.240185}, {0.411541, 0.414704, 0.420417, 0.482359, 0.540169},
{0.640515,
0.671011, 0.672597, 0.725082, 0.742558, 0.790636, 0.854031, 0.875499}}
3

If that is what you want, then write and document a routine for your custom
use.

groupValues::usage =
"groupValues[epsilon][valuelist] will sort and group the numbers in \
valuelist whenever the gap between two successive values is greater than or
\
equal to epsilon.";
groupValues[epsilon_?Positive][valuelist : {__?NumericQ}] :=
Split[Sort[valuelist], #2 - #1 < epsilon &]

testset // groupValues[epsilon]
Length[%]
{{0.0146134, 0.0476439, 0.0538857, 0.0711807, 0.136822, 0.1915,
0.240185}, {0.411541, 0.414704, 0.420417, 0.482359, 0.540169},
{0.640515,
0.671011, 0.672597, 0.725082, 0.742558, 0.790636, 0.854031, 0.875499}}
3

It will almost always be worthwhile to write routines to extend Mathematica
to conveniently do the things you want. Sometimes they might be quite
extensive, and sometimes, as in this example, they might be simple
combinations that are easier to use and save typing. If you build up sets of
such routines you will soon find that Mathematica is much more powerful and
convenient.

David Park

From: Barrow [mailto:GRseminar@gmail.com]

Dear all,
I have a list of numbers (A),in fact, they are numbers distributed
over [0,1].  Given parameter \epsilon, I have to choose elements from A
such that their distances are larger than \epsilon, so the elements are
"distringuishable". My goal is to find the maximum number of elements
from A to meet the above "distinct criterion".
How to do it with the functions build-in in mathematica ??


 0
Reply djmp (1214) 12/31/2006 10:19:26 AM

Dear group,

Thank you.

Peter Pein schrieb:

> Hi Barrow,
>
> the first method coming to my mind has been the use of ReplaceRepeated, but
> for long lists this lasts far too long:
>
>
> A=Table[Random[],{2000}];
> epsilon=1.*^-4;
>
> Timing[Length[
>     r1=A//.{x___,c_,y___}/;Min[Abs[c-{x,y}]]<epsilon:>{x,y}
>     ]]
>
> --> {22.125 Second,1650}
>
> It is sufficient to compare element k with elements k+1,...,n:
>
> selectDistinguishable[a_List,eps_]:=
>   Pick[a,Min[Abs[a[[#]]-Drop[a,#]]]>eps&/@Range[Length[a]]]
>
> Timing[Length[
>     r2=selectDistinguishable[A,epsilon]
>     ]]
>
> --> {0.11 Second,1650}
>
> _Much_ better :-)
>
> r1===r2
> --> True
>
> hth,
> Peter
>


 0
Reply petsie (836) 1/1/2007 8:53:30 AM

3 Replies
55 Views

Similar Articles

12/9/2013 4:49:14 PM
[PageSpeed]