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