Re: inert wrapping function

• To: mathgroup at smc.vnet.net
• Subject: [mg5781] Re: inert wrapping function
• From: Robert Villegas <villegas>
• Date: Sat, 18 Jan 1997 14:58:34 -0500
• Sender: owner-wri-mathgroup at wolfram.com

```> Is there a way to make fa[] Flat, not only over sequences of arguments, but
> over sums and (scalar) products ? Call it 'LinearlyFlat' or so.
>
> The only thing it should do is to automatically Thread over sums or linear
> combinations of fa[]'s :
>
> fa[a fa[A] + b fa[B] + c fa[C] ] should evaluate to  a fa[A] + b fa[B] + c fa[C]

Here's one idea:  given fa[expr], discard the head fa if the expanded form
of expr matches either

(1)  _. _fa

(2)  head Plus with elements matching (1)

This can be implemented as follows:

In[1]:= fa[expr_ /; MatchQ[Expand[expr], (_. _fa) | HoldPattern[Plus[(_.
_fa)..]]] ] := expr

In[2]:= fa[ fa[x] ]

Out[2]= fa[x]

In[3]:= fa[ a fa[x] ]

Out[3]= a fa[x]

In[4]:= fa[ a fa[x] + b fa[y] ]

Out[4]= a fa[x] + b fa[y]

In[5]:= fa[a fa[A] + b fa[fa[ a fa[A] + b fa[B] + c fa[C] ]]]

Out[5]= a fa[A] + b (a fa[A] + b fa[B] + c fa[C])

Here is an example where fa refuses to be discarded, because one of
the terms in the sum isn't a multiple of f[_]:

In[10]:= fa[a + b f[y]]

Out[10]= fa[a + b f[y]]

I think that's what you want, though I'm not sure.

> Please, check any suggestions against the following nasty test that creates
> a nested list of fa[]'s :
> All fA, ... fL should end up inside a wrapper fa[], end all a ... l outside
> of it.

This passes the test, and it works fast:

In[8]:= (
a1={fA,fB,fC,fD,fE,fF};
a2={a,b,c,d,e,f};  a2=a2/Plus@@a2;
b1={fG,fH,fI,fJ,fK,fL};
b2={g,h,i,j,k,l};  b2=b2/Plus@@b2;
big1 = (fb/@a1) . a2;
big2 = big1 /.fb[fC]->(fb/@b1) . b2;
big3 = Nest[#/.fb[fJ]->(fb/@b1) . b2 &,big2,3]//fb;
)

In[9]:= Timing[big3 /. fb -> fa]

a fa[fA]                b fa[fB]
Out[9]= {0.281264 Second, --------------------- + --------------------- +
a + b + c + d + e + f   a + b + c + d + e + f
d fa[fD]                e fa[fE]                f fa[fF]
--------------------- + --------------------- + --------------------- +
a + b + c + d + e + f   a + b + c + d + e + f   a + b + c + d + e + f
g fa[fG]                h fa[fH]
(c (--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
i fa[fI]                k fa[fK]
--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
l fa[fL]
--------------------- +
g + h + i + j + k + l
g fa[fG]                h fa[fH]
(j (--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
i fa[fI]                k fa[fK]
--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
l fa[fL]
--------------------- +
g + h + i + j + k + l
g fa[fG]                h fa[fH]
(j (--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
i fa[fI]                k fa[fK]
--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
l fa[fL]
--------------------- +
g + h + i + j + k + l
g fa[fG]                h fa[fH]
(j (--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
i fa[fI]                j fa[fJ]
--------------------- + --------------------- +
g + h + i + j + k + l   g + h + i + j + k + l
k fa[fK]                l fa[fL]
--------------------- + ---------------------)) /
g + h + i + j + k + l   g + h + i + j + k + l
(g + h + i + j + k + l))) / (g + h + i + j + k + l))) /
(g + h + i + j + k + l))) / (a + b + c + d + e + f)}

Robby Villegas

```

• Prev by Date: Re: Mathematica 2 problem
• Next by Date: Re: Re: GroebnerBasis
• Previous by thread: Re: inert wrapping function
• Next by thread: batch mode mathematica