Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1997
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1997

[Date Index] [Thread Index] [Author Index]

Search the Archive

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