Re: programming problem about elements taken
- To: mathgroup at smc.vnet.net
- Subject: [mg72485] Re: programming problem about elements taken
- From: Peter Pein <petsie at dordos.net>
- Date: Mon, 1 Jan 2007 03:55:02 -0500 (EST)
- References: <en82n6$6qb$1@smc.vnet.net>
Bob Hanlon schrieb:
> For a sorted output:
>
> choose1[a_?VectorQ, epsilon_?NumericQ]:=Module[
> {sa=Sort[a]},
> Fold[If[#2-Last[#1]>epsilon,
> Append[#1,#2],#1]&,{First[sa]},Rest[sa]]];
>
> To retain the original element order:
>
> choose2[a_?VectorQ, epsilon_?NumericQ]:=Module[
> {sa=Sort[a]},
> Select[a,MemberQ[Fold[If[#2-Last[#1]>epsilon,
> Append[#1,#2],#1]&,{First[sa]},Rest[sa]], #]&]];
>
> a=Table[Random[],{20}]
>
> {0.67319,0.378445,0.981498,0.579474,0.798173,0.537112,0.884835,0.534093,0.\
> 0471484,0.0516117,0.988746,0.570592,0.261828,0.632062,0.754747,0.436792,0.\
> 669037,0.149373,0.802271,0.484141}
>
> choose1[a,0.1]
>
> {0.0471484,0.149373,0.261828,0.378445,0.484141,0.632062,0.754747,0.884835,0.\
> 988746}
>
> choose2[a,0.1]
>
> {0.378445,0.884835,0.0471484,0.988746,0.261828,0.632062,0.754747,0.149373,0.\
> 484141}
>
> %%==Sort[%]
>
> True
>
> However, the second method (original order) is much slower for a large list.
>
> a=Table[Random[],{1000}];
>
> Timing[choose1[a,0.1];]
>
> {0.008364 Second,Null}
>
> Timing[choose2[a,0.1];]
>
> {1.23431 Second,Null}
>
>
> Bob Hanlon
>
> ---- Barrow <GRseminar at gmail.com> wrote:
>> 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 Bob,
you can keep the original order in a fast way, when working with the
Ordering[] of the list:
In[1]:=
SeedRandom[1];
A = Table[Random[], {10^4}];
epsilon = 0.001;
Timing[Length[r1 = Union[A, SameTest -> (Abs[#1 - #2] < epsilon & )]]]
Out[4]= {1.625 Second,907}
In[5]:=
selectDistinguishable[a_List, eps_] :=
Module[{ix = Ordering[a]},
a[[ Sort@Fold[If[Abs[a[[{Last[#1], #2}]].{1,-1}] > epsilon,
Append[#1, #2], #1] & , {First[ix]}, Rest[ix]] ]]
]
Timing[Length[r2 = selectDistinguishable[A, epsilon]]]
Out[6]= {0.016 Second,907}
In[7]:= r1===Sort[r2]
Out[7]= True
P²