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