Re: list equation
- To: mathgroup at smc.vnet.net
- Subject: [mg121995] Re: list equation
- From: Ray Koopman <koopman at sfu.ca>
- Date: Sat, 8 Oct 2011 05:34:18 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <j6jpek$me8$1@smc.vnet.net>
On Oct 6, 1:38 am, dimitris <dimmec... at yahoo.com> wrote:
> Hello to all.
>
> Let
>
> lst = Tuples[Range[100], 2];
>
> In the previous list appear elements such us {x,y} and {y,x}.
> (e.g. {3,4} and {4,3}). I want to create a new list with {y,x}
> dropped (that is, in the new list appears only {3,4} and not {4,3}).
>
> I use
>
> lstnew = Union[lst, SameTest -> (#1 == Reverse[#2] &)]
>
> However it is needed almost 150 sec for this procedure
> ($Version->5.2 for Windows)
> I know that my laptop is too old but I guess there is a more
> efficient way to create lstnew.
>
> Any ideas?
>
> Thanks a lot
>
> Dimitris
Here are three solutions, all of which are much faster.
The first, which has already been mentioned by Simon and Chris,
is probably the easiest to understand:
Flatten[Table[{i,j},{i,n},{j,i,n}],1]
where 'n' in your example was 100.
Subsets[Range@n,{2}] is very fast, but it omits terms like {x,x}.
One fixup, which is a little faster than Table, is
#+{1,0}& /@ Subsets[Range[0,n],{2}]
A more obscure fixup, which is almost twice as fast as Table, is
Transpose @ {#[[1]]+1,#[[2]]}& @
Transpose @ Subsets[Range[0,n],{2}]
In[1]:=
{n = 100, r = 1*^3}; Timing@Do[Null,{1*^7}];
Timing[Do[a = Flatten[Table[{i,j},{i,n},{j,i,n}],1],{r}];{n,r}]
Timing[Do[b = #+{1,0}&/@Subsets[Range[0,n],{2}],{r}];{n,r}]
Timing[Do[c = Transpose@{#[[1]]+1,#[[2]]}&@Transpose@
Subsets[Range[0,n],{2}],{r}];{n,r}]
SameQ[a,b,c]
$Version
Out[2]= {8.62 Second,{100,1000}}
Out[3]= {7.79 Second,{100,1000}}
Out[4]= {4.42 Second,{100,1000}}
Out[5]= True
Out[6]= 5.2 for Mac OS X (June 20, 2005)
The Null timing loop adjusts for the fact that, when several Timing
calls as entered together, the first time returned is usually about
.10 to .15 too long.