Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*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 2005

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

Search the Archive

Re: Set of strings reducing problem

  • To: mathgroup at smc.vnet.net
  • Subject: [mg58584] Re: Set of strings reducing problem
  • From: "dkr" <dkrjeg at adelphia.net>
  • Date: Fri, 8 Jul 2005 00:46:16 -0400 (EDT)
  • References: <daitu8$t2v$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

compareString compares two strings and generates the desired string if
there is a single mismatch.  Otherwise it generates {}.

In[1]:=
compareStrings[a_String,a_String]:={};
compareStrings[str1_String,str2_String]/;Equal[Length[str1],Length[str2]]:=
    Module[{pos,chars1,chars2,thr,rules},
      rules={{"1","X"}|{"X","1"}:>"D", {"1","2"}|{"2","1"} :>

"M",{"1","U"}|{"U","1"}|{"M","X"}|{"X","M"}|{"2","D"}|{"D","2"}:>
            "T",{"2","X"}|{"X","2"}:>"U"};
      chars1=Characters[str1]; chars2=Characters[str2];
      thr=Thread[{chars1,chars2}];
      pos=Position[thr,{a_,b_}/;b=!=a,{1},2];
        If[ Equal[Length[pos],2],{},

StringJoin[ReplacePart[chars1,Extract[thr,First[pos]]/.rules,pos]]]];

Note the last argument of Position.  There is no need to search beyond
the second mismatch.


In[3]:=
compareStrings["11112111","1111X111"]
Out[3]=
1111U111
compareStrings["11112111","1111X121"]
Out[4]=
{}


It wasn't exactly clear what you meant by taking all transformations.
If you want to look at all possible pairs of the original strings,
generating a new string from a pair only if there is a single mismatch,
and then looking at the collection of all the generated strings, you
can:

In[12]:=
genStrings[a_List]:=Flatten[compareStrings[#[[1]],#[[2]]]&/@Subsets[a,{2}]];

In[14]:=
origList={"11112111","1111X111","11111111","11112111","21122211","D1122211"};

In[15]:=
genStrings[origList]
Out[15]=
{1111U111,1111M111,1111D111,1111U111,1111M111,T1122211}


  • Prev by Date: Re: Mathematica query
  • Next by Date: Re: Using InterpolatingFunction from NDSolve
  • Previous by thread: Re: Set of strings reducing problem
  • Next by thread: Re: Set of strings reducing problem