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
>