MathGroup Archive 2007

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

Search the Archive

Re: a special type of strings!

  • To: mathgroup at smc.vnet.net
  • Subject: [mg78781] Re: a special type of strings!
  • From: Peter Pein <petsie at dordos.net>
  • Date: Mon, 9 Jul 2007 01:40:59 -0400 (EDT)
  • References: <f6npb1$6r1$1@smc.vnet.net> <f6qds1$9nl$1@smc.vnet.net>

I had a look at this task this morning and noticed an easier solution.

If you don't mind to get some global variables, this is about three
times faster in generating AllNormalSequences[9]:

Your data:
op = {{a}, {b, c}, {d, e, f}, {g, h}};
threeSeqs =
{{d, b, a, g, e, f, c, a, e},
 {a, d, b, a, b, e, c, a, h},
 {g, g, h, d, f, d, b, c, c}};

now build all possible rules for an successor:

successorRules = Dispatch[Flatten[
  {{} -> List /@ Join @@ op,
  (s:{___, #1} -> (Join[s, {#1}] & ) /@ Join @@ op & ) /@ op[[1]],
  Table[(s:{___, #1} ->
     (Join[s, {#1}] & ) /@ Join @@ Take[op, {k - 1, k}] & ) /@ op[[k]],
   {k, 2, Length[op]}]}]]

gives:

{{} -> {{a}, {b}, {c}, {d}, {e}, {f}, {g}, {h}},
 s:{___, a} -> {Join[s, {a}], Join[s, {b}], Join[s, {c}], Join[s, {d}],
                Join[s, {e}], Join[s, {f}], Join[s, {g}], Join[s, {h}]},
 s:{___, b} -> {Join[s, {a}], Join[s, {b}], Join[s, {c}]},
 s:{___, c} -> {Join[s, {a}], Join[s, {b}], Join[s, {c}]},
 s:{___, d} -> {Join[s, {b}], Join[s, {c}], Join[s, {d}], Join[s, {e}],
                Join[s, {f}]},
 s:{___, e} -> {Join[s, {b}], Join[s, {c}], Join[s, {d}], Join[s, {e}],
                Join[s, {f}]},
 s:{___, f} -> {Join[s, {b}], Join[s, {c}], Join[s, {d}], Join[s, {e}],
                Join[s, {f}]},
 s:{___, g} -> {Join[s, {d}], Join[s, {e}], Join[s, {f}], Join[s, {g}],
                Join[s, {h}]},
 s:{___, h} -> {Join[s, {d}], Join[s, {e}], Join[s, {f}], Join[s, {g}],
                Join[s, {h}]}}

to generate all normal sequences, apply these rules repeatedly:

AllNormalSequences[k_] :=
   Nest[Join @@ (#1 /. successorRules & ) /@ #1 &,  {{}}, k]

Timing[Length[all9 = AllNormalSequences[9]]]

   {5.368336*Second, 1542156}

and the list is ordered (maybe usefull?)

OrderedQ[all9]

   True

defining NormalSequenceQ is simple, usining another global var:

normalPairs = AllNormalSequences[2];
NormalSequence := Complement[Partition[#, 2, 1], normalPairs] === {} &

Timing[Block[{result},
  Do[result=NormalSequence/@threeSeqs,{10^4}];
  result]]*{10^-4,1}

   {0.0000596037 Second,{True,False,True}}

Greetings,
Peter

Peter Pein schrieb:
> mumat schrieb:
>> Hi Everyone,
>>
>> I have an alphabet A= {a,b,c,d,e,f,g,h}. letters in A are grouped as
>> follows:
>>
>> group1: G1={a}
>> group2:G2={b,c},
>> group3:G3={d,e,f},
>> group4: G4={g,h}.
>>
>> In other words, we have {{a},{b,c},{d,e,f},{g,h}} as an ordered
>> partition of A.
>>
>> We say the string \alpha=s_1,s_2,s_3,...,s_n  to be NORMAL
>>
>> if and only if
>>
>> for every i,j: ( if s_i  is in  Gj  then, (s_(i+1) is in Gj or s_(i+1)
>> is in G(j-1)   ) OR   (s_i is in G1).
>>
>>
>> For instance the following three sequences are normal:
>>
>> Seq1: d,b,a,g,e,f,c,a,e
>> Seq2: a,d,b,a,b,e,c,a,h.
>> Seq3: g,g,h,d,f,d,b,c.
>>
>> I need to write a code to determine weather a given sequence is
>> Normal:
>>
>> NormalQ[seq_]:=....
>>
>> and also generating all normal sequences of a particular length k:
>> AllNormalSequences[k].
>>
>>
>> Any help would be greately appreciated.
>>
>> best regards,
>>
>> chekad sarami
>>
>>
> 
> Hi!
> 
> I'm afraid, your second example is not a normal sequence ("e" must  not
> follow "b").
> 
> I used the pattern matching capabilities of Mathematica, to generate all
> normal sequences.
> 
> The function succ takes a (possibly empty) sequence and an ordered
> partition and gives a list of letters which may extend the sequence given.
> 
> succ[{___, letter_} | {}, ordpart : {{___, letter_, ___}, ___}] :=
>     Join @@ ordpart;
> succ[{___, letter_}, {___, s1 : {__}, s2 : {___, letter_, ___}, ___}] :=
>     Join[s1, s2];
> 
> The function successor just takes the letters found by "succ" and builds
> all possible extensions of "seq":
> 
> successors[seq_, ordpart_] := Flatten[{seq, #}] & /@ succ[seq, ordpart];
> 
> To get all normal sequences of length k, take the function "successor"
> and iterate it k times, starting with the list with the empty sequence
> as element:
> 
> AllNormalSequences[k_, ordpart_] :=
>   Nest[Flatten[successors[#, ordpart] & /@ #, 1] &, {{}}, k]
> 
> 
> To test whether a given sequence is normal, I get the index of the
> corresponding Gi for each element. Building the difference of subsequent
> indices, the result has to be 0 or 1 OR the index is 1 (before building
> the differences:
> 
> NormalSequenceQ[seq_,ordpart_]:=
>   Module[{ps=Position[ordpart,#,{2},1][[1,1]]&/@seq},
>     #(1-#)&[Subtract[##]].(#1-1)&@@Through[{Most,Rest}[ps]]===0
>   ]
> 
> 
> Test:
> the ordered partition and your examples (I extended the third one to get
> nine elements):
> 
> op = {{a}, {b, c}, {d, e, f}, {g, h}};
> threeSeqs =
>  {{d, b, a, g, e, f, c, a, e},
>   {a, d, b, a, b, e, c, a, h},
>   {g, g, h, d, f, d, b, c, c}};
> 
> How many normal sequences of length 9 exist?
> 
> Timing[Length[all9 = AllNormalSequences[9, op]]]
> 
>     {14.4609*Second, 1542156}
> 
> How do they look like?
> 
> ((Print["Sequences ", #1" to ", #2, ": "] & ) @@ #1; Take[all9, #1]) & [
>      Random[Integer, {1, Length[all9] - 2}] + {0, 2}]
> 
>     Sequences 777023 to 777025:
> 
>     {{d, f, f, d, c, a, a, e, f},
>      {d, f, f, d, c, a, a, f, b},
>      {d, f, f, d, c, a, a, f, c}}
> 
> Are your examples in the large set?
> 
> Timing[MemberQ[all9, #1]& /@ threeSeqs]
> 
>     {0.408026*Second, {True, False, True}}
> 
> oops ;-)
> 
> And of course it is much faster to test a sequence, than to look for it
> in a big list:
> 
> Timing[NormalSequenceQ[#1, op]& /@ threeSeqs]
> 
>     {0.*Second, {True, False, True}}
> 
> 
> Greetings,
> Peter
> 


  • Prev by Date: Re: Mathematica forgets a solution in DSolve!!!
  • Next by Date: M^2 (definite integral)
  • Previous by thread: Re: a special type of strings!
  • Next by thread: DensityPlot colours misbehaving