RE: RE: Expanding a nested structure (pattern matching?)
- To: mathgroup at smc.vnet.net
- Subject: [mg24875] RE: [mg24855] RE: [mg24835] Expanding a nested structure (pattern matching?)
- From: Wolf Hartmut <hwolf at debis.com>
- Date: Sat, 19 Aug 2000 04:45:49 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Dear David,
after having seen your reply, I agree to your opinion on this question. And
I welcome your test cases. (Quite so often replies to postings could have
been more useful if they were supplied with those in first place.) With
respect to the procedure, here I propose an alternative which might interest
you (and hopefully John as well). See below:
> -----Original Message-----
> From: David Park [SMTP:djmp at earthlink.net]
To: mathgroup at smc.vnet.net
> Sent: Wednesday, August 16, 2000 9:24 AM
> To: mathgroup at smc.vnet.net
> Subject: [mg24855] RE: [mg24835] Expanding a nested structure
> (pattern matching?)
>
> Dear John,
>
> A wonderful question actually! I am looking forward to the answers you
> will
> get. Here is one approach that seemed to work. (You don't want to use
> capital D as a symbol because it has a predefined meaning. Best to stay
> with
> small letters.)
>
> structureexpand[expr_] :=
> FixedPoint[
> Flatten[(# /.
> a_[b_List, c_List] :>
> Flatten[Outer[a, b, c]]) //. (a_ /; FreeQ[a, List])[b___,
> c_List, d___] :> ((a[b, #, d] &) /@ c)] &, expr]
>
> I tried it on three expressions.
>
> e1 = a[b, c, d[{f, g}, {h, j}]]
> e2 = a[b, c, d[e, f[{f1, f2}, {f3, f4}]]]
> e3 = a[b, c[{c1, c2}, {c3, c4}], d[e, f[{f1, f2}, {f3, f4}]]]
>
> structureexpand[e1]
> {a[b, c, d[f, h]], a[b, c, d[f, j]], a[b, c, d[g, h]], a[b, c, d[g, j]]}
>
> structureexpand[e2]
> {a[b, c, d[e, f[f1, f3]]], a[b, c, d[e, f[f1, f4]]], a[b, c, d[e, f[f2,
> f3]]],
> a[b, c, d[e, f[f2, f4]]]}
>
> structureexpand[e3]
> {a[b, c[c1, c3], d[e, f[f1, f3]]], a[b, c[c1, c3], d[e, f[f1, f4]]],
> a[b, c[c1, c3], d[e, f[f2, f3]]], a[b, c[c1, c3], d[e, f[f2, f4]]],
> a[b, c[c1, c4], d[e, f[f1, f3]]], a[b, c[c1, c4], d[e, f[f1, f4]]],
> a[b, c[c1, c4], d[e, f[f2, f3]]], a[b, c[c1, c4], d[e, f[f2, f4]]],
> a[b, c[c2, c3], d[e, f[f1, f3]]], a[b, c[c2, c3], d[e, f[f1, f4]]],
> a[b, c[c2, c3], d[e, f[f2, f3]]], a[b, c[c2, c3], d[e, f[f2, f4]]],
> a[b, c[c2, c4], d[e, f[f1, f3]]], a[b, c[c2, c4], d[e, f[f1, f4]]],
> a[b, c[c2, c4], d[e, f[f2, f3]]], a[b, c[c2, c4], d[e, f[f2, f4]]]}
>
> David Park
> djmp at earthlink.net
> http://home.earthlink.net/~djmp/
>
>
> -----Original Message-----
> > From: John A. Gunnels [mailto:gunnels at cs.utexas.edu]
To: mathgroup at smc.vnet.net
> To: mathgroup at smc.vnet.net
> > Sent: Tuesday, August 15, 2000 3:04 AM
> > To: mathgroup at smc.vnet.net
> > Subject: [mg24875] [mg24855] [mg24835] Expanding a nested structure (pattern
> matching?)
> >
> >
> > I hope that this is not a _really_ stupid question, but I have run
> > into what appears to be a problem using rewrite rules to un-nest
> > a structure.
> >
> > The crux of the problem (I have tried to make it as simple as possible
> > without losing the essence of my difficulty) has to do with duplicating
> > the structure surrounding the terms that I wish to rewrite.
> >
> > Any nested list is intended to represent a choice point and my rewrite
> > rules are aimed at enumerating all of the possible sequences of choices.
> >
> > An example:
> > Input:
> > A[B, C, D[ {F, G}, {H, J}]]
> > should become
> > A[B, C, D[F, H]],
> > A[B, C, D[F, J]],
> > A[B, C, D[G, J]],
> > A[B, C, D[G, J]]
> >
> > Obviously, the order isn't important, but the nesting isn't restricted
> > to level 2 nor am I guaranteed that all heads or elements are unique.
> > I realize that I may have to simply write the code that iterates through
> > the different Depth[]s, but this seems like it might have a very clean
> > answer that simply hasn't occurred to me.
> >
> > Thanks,
> > John A. Gunnels
> > gunnels at cs.utexas.edu
> >
> >
>
[Hartmut Wolf]
In my first reply to this post, I had proposed to Map Distribute to the
right position. Now an alternative to "the right position" would be "every
position"; yet there is a difficulty with Distributing over nonatomic
expressions not containing list (they are just returned _within_ a List),
which makes no sense in this context and prevents the solution. So we define
our own version:
dsb[h_ /; MemberQ[h, {___}] && Head[h] =!= List] := Distribute[h, List]
dsb[a_] := a
(* we distribute any expression containing lists over List, however we do
not distribute nested lists. Of course normally you would come from the
other side: qualify those heads which _do_ distribute (give them the
attribute "distributive" -- so to speak) *)
sol[dsb, e1] = dsb //@ e1 // TableForm
a[b, c, d[f, h]]
a[b, c, d[f, j]]
a[b, c, d[g, h]]
a[b, c, d[g, j]]
sol[dsb, e2] = dsb //@ e2 // TableForm
a[b, c, d[e, f[f1, f3]]]
a[b, c, d[e, f[f1, f4]]]
a[b, c, d[e, f[f2, f3]]]
a[b, c, d[e, f[f2, f4]]]
sol[dsb, e3] = dsb //@ e3 // TableForm
a[b, c[c1, c3], d[e, f[f1, f3]]]
a[b, c[c1, c3], d[e, f[f1, f4]]]
a[b, c[c1, c3], d[e, f[f2, f3]]]
a[b, c[c1, c3], d[e, f[f2, f4]]]
a[b, c[c1, c4], d[e, f[f1, f3]]]
a[b, c[c1, c4], d[e, f[f1, f4]]]
a[b, c[c1, c4], d[e, f[f2, f3]]]
a[b, c[c1, c4], d[e, f[f2, f4]]]
a[b, c[c2, c3], d[e, f[f1, f3]]]
a[b, c[c2, c3], d[e, f[f1, f4]]]
a[b, c[c2, c3], d[e, f[f2, f3]]]
a[b, c[c2, c3], d[e, f[f2, f4]]]
a[b, c[c2, c4], d[e, f[f1, f3]]]
a[b, c[c2, c4], d[e, f[f1, f4]]]
a[b, c[c2, c4], d[e, f[f2, f3]]]
a[b, c[c2, c4], d[e, f[f2, f4]]]
(structureexpand[#] // TableForm) === sol[dsb, #] & /@ {e1, e2, e3}
{True, True, True}
So the results are the same here. And of course there will be cases were our
functions differ, esp. Distribute and Flatten[Outer[...]] differ with nested
lists, e.g. with
e4 = f[{a, b}, {{c1, c2}, {d1, d2}}]
we get
structureexpand[e4]
{f[a, c1], f[a, c2], f[a, d1], f[a, d2], f[b, c1], f[b, c2], f[b, d1],
f[b, d2]}
but
dsb //@ e4
{f[a, {c1, c2}], f[a, {d1, d2}], f[b, {c1, c2}], f[b, {d1, d2}]}
What is more like to John's wishes, depends on his application which we
don't know. One might argue that the operation should be applied
recursively, so...
FixedPoint[dsby //@ # &, e4]
{{f[a, c1], f[a, c2]}, {f[a, d1], f[a, d2]},
{f[b, c1], f[b, c2]}, {f[b, d1], f[b, d2]}}
...would do. This is essentially David's result, containing remnants of the
input structure. This may be desired, otherwise Flatten it away.
There is yet another way to come to David's result in this case, namely by
first flattening nested lists, before distributing. Define
flatt[a_?AtomQ] := a
flatt[x_] := Flatten[x]
and then
dsb //@ flatt //@ e4
{f[a, c1], f[a, c2], f[a, d1], f[a, d2], f[b, c1], f[b, c2], f[b, d1],
f[b, d2]}
(In this case you need not check for head List in dsb.)
Also redefining...
dsb2[h_List] := Flatten[h]
dsb2[h_ /; MemberQ[h, {___}]] := Distribute[h, List]
dsb2[a_] := a
dsb2 //@ e4
{f[a, c1], f[a, c2], f[a, d1], f[a, d2], f[b, c1], f[b, c2], f[b, d1],
f[b, d2]}
...would help (and perhaps be quite performant, but I didn't test for that).
Kind regards, Hartmut