Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1999
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Element Extraction

  • To: mathgroup at smc.vnet.net
  • Subject: [mg19307] Re: [mg19240] Element Extraction
  • From: "Carl K.Woll" <carlw at fermi.phys.washington.edu>
  • Date: Sat, 14 Aug 1999 23:42:43 -0400
  • Organization: Department of Physics
  • References: <199908110606.CAA01017@smc.vnet.net.>
  • Sender: owner-wri-mathgroup at wolfram.com

Hi all,

I thought I would give a comparison of the various solutions provided, along with
a couple of new ones by yours truly.

(* Hayes *)
hamming[1][lis_,tar_]:=
  Cases[lis,x_/;Count[MapThread[SameQ,{target,x}],False]<=1]

(* Park *)
hammtest[p : {_, _, _}, t : {_, _, _}] := Count[Abs[t - p], 0] > 1;

hamming[2][lis_,tar_]:=Select[lis,hammtest[#,tar]&]

(* Kozlowski *)
dist[a_, b_] := If[a === b, 0, 1]
SetAttributes[dist, Listable]

hamming[3][lis_,tar_]:=Select[lis, Apply[Plus, dist[tar, #]] <= 1 &]

(* Hanlon *)
hammingDistance[x_?VectorQ, y_?VectorQ] /; Length[x] == Length[y] :=
    Plus @@ MapThread[If[#1 == #2, 0, 1] &, {x, y}];

hamming[4][lis_,tar_]:=Select[lis, hammingDistance[tar, #] < 2 &]

(* Woll #1 *)
Clear[closeEnough];
closeEnough[{True,True,True}]=True;
closeEnough[{True,True,False}]=True;
closeEnough[{True,False,True}]=True;
closeEnough[{False,True,True}]=True;

hamming[5][lis_,tar_]:=Module[{ans},
  SetAttributes[SameQ,{Listable}];
  ans=Select[lis,closeEnough[SameQ[#,tar]]&];
  ClearAttributes[SameQ,{Listable}];
  ans]

(* Woll #2 *)
Clear[success]
success[True,True,True]=0;
success[True,True,False]=0;
success[True,False,True]=0;
success[False,True,True]=0;

hamming[6][lis_,tar_]:=Module[{ans,t,len=Length[lis]},
  SetAttributes[SameQ,{Listable}];
  t=SameQ[testlist,Table[tar,{len}]];
  ans=lis[[Flatten[Position[Apply[success,t,1],0]]]];
  ClearAttributes[SameQ,{Listable}];
  ans]
In[22]:=
target = {0, 0, 1};
In[263]:=
testlist =
    Table[{Random[Integer, {0, 2}], Random[Integer, {0, 2}],
        Random[Integer, {0, 2}]}, {10000}];
In[381]:=
Do[Print[Timing[r[i]=hamming[i][testlist,target];]],{i,1,6}]

r[1]==r[2]==r[3]==r[4]==r[5]==r[6]
{2.703 Second,Null}
{3.937 Second,Null}
{3.969 Second,Null}
{5.234 Second,Null}
{1.125 Second,Null}
{0.969 Second,Null}
Out[382]=
True

Carl Woll
Dept of Physics
U of Washington

Kew Joinery wrote:

> Hello everyone,
> I have a problem extracting list of list.
> Given some list, consisting of elements (not all of them distinct) with
> the same length and some target list of the same length, for example:
> In[26]:=
> someList={{0,0,0},{0,0,1},{0,0,2},{0,1,0},{0,1,1},{0,1,2},{0,2,0},{0,2,1},{0,
>
> 2,2},{1,0,0},{1,0,1},{1,0,2},{1,1,0},{1,1,1},{1,1,2},{1,2,0},{1,2,1},{1,
>
> 2,2},{2,0,0},{2,0,1},{2,0,2},{2,1,0},{2,1,1},{2,1,2},{2,2,0},{2,2,1},{2,
>
>       2,2}};
>
> In[27]:=
> target={0,0,1};
>
> Hamming distance between two bit strings means the number of bit
> positions in which they differ. For example consecutive elements of the
> Gray code list have Hamming distance = 1.
> I need to extract these cases(elements of someList) which differ from
> target in one coordinate (Hamming distance = 1) or less (the
> element===target itself//Hamming distance=0), so the answer should be:
>
> In[33]:=
> answer={{0,0,0},{0,0,1},{0,0,2},{0,1,1},{0,2,1},{1,0,1},{2,0,1}};
>
> How could I achieve the extraction efficiently?
> Thank you in advance for any suggestions.
> Eugene



  • Prev by Date: Control Function With NDsolve
  • Next by Date: Re: Win32 MathLink .exe from Matheamtica 3 on a Mac
  • Previous by thread: Element Extraction
  • Next by thread: Re: Element Extraction