MathGroup Archive 2002

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

Search the Archive

RE: Operating on Level Subparts of an Expression

  • To: mathgroup at smc.vnet.net
  • Subject: [mg36311] RE: [mg36303] Operating on Level Subparts of an Expression
  • From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
  • Date: Sat, 31 Aug 2002 01:25:54 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

-----Original Message-----
From: Wolf, Hartmut 
To: mathgroup at smc.vnet.net
Subject: [mg36311] RE: [mg36303] Operating on Level Subparts of an Expression



>-----Original Message-----
>From: David Park [mailto:djmp at earthlink.net]
To: mathgroup at smc.vnet.net
>Sent: Friday, August 30, 2002 7:20 AM
>Subject: [mg36311] [mg36303] Operating on Level Subparts of an Expression
>
>
>Yesterday I posted a question on using named patterns in a 
>rule. I received
>a number of useful replies and thank all those who responded. 
>Today I have a
>question that actually generated yesterday's question. I am using a new
>subject heading to reflect the actual nature of the question.
>
>What is the best way in Mathematica to operate on some, but 
>not all, level
>parts of an expression or subexpression?
>
>Suppose I have the following expression...
>
>expr = f1[a]f2[b]f3[c]f4[d];
>
>and I want to do an operation, op, separately on f1[a]f3[c] 
>and f2[b]f4[d].
>The operation must be done on the given pairs and not on all 
>four factors at
>once. One method is to use explicit exact substitution rules.
>
>expr /. f1[a]f3[c] :> op[f1[a]f3[c]] /. f2[b]f4[d] :> op[f2[b]f4[d]]
>op[f1[a] f3[c]] op[f2[b] f4[d]]
>
>If a,b,c,d were long expressions, we might not want to type or 
>copy them in.
>This raised my question of using named patterns. Hartmut Wolf 
>pointed out
>that each factor must be named to create a match with flat 
>expressions. So
>we could use...
>
>expr /. (a : f1[_])(b : f3[_])(c : f2[_])(d : f4[_]) :> op[a b]op[c d]
>op[f1[a] f3[c]] op[f2[b] f4[d]]
>
>Andrzej Kozlowski suggested a method using Take, but using 
>Part works better
>here, so we could use...
>
>expr /. a_ :> op[a[[{1, 3}]]]*op[a[[{2, 4}]]]
>op[f1[a] f3[c]] op[f2[b] f4[d]]
>
>All of the above methods use rules. Is it possible to do it with
>ReplacePart? I don't think so, but maybe somebody knows how to 
>do it. How
>about using MapAt? I don't think that works either in regular 
>Mathematica.
>Ted Ersek and I did a package, Algebra`ExpressionManipulation` 
>at my web
>site, that implements extended positions. An extended position 
>gives the
>position of an expression and a list of the desired subparts 
>and is packaged
>in a header eP. So the extended position of a + c in
>f[a + b + c + d] is eP[{1},{1,3}]. The package modifies MapAt to accept
>extended positions. Then we can use...
>
>MapAt[op, expr, {eP[{}, {1, 3}], eP[{}, {2, 4}]}]
>op[f1[a] f3[c]] op[f2[b] f4[d]]
>
>However, I don't always like to drag in the package just to do 
>that. I think
>that operating on selected level parts of a subexpression is 
>not all that
>uncommon.
>
>Here is another example.
>
>1 - Cos[x]^2
>% // TrigFactor
>1 - Cos[x]^2
>Sin[x]^2
>
>But...
>
>1 - a - Cos[x]^2
>% // TrigFactor
>1 - a - Cos[x]^2
>(1/2)*(1 - 2*a - Cos[2*x])
>
>I was hoping for -a + Sin[x]^2. What are the best methods for 
>handling this
>kind of problem in regular Mathematica?
>
>David Park
>djmp at earthlink.net
>http://home.earthlink.net/~djmp/
>
>
>
>David Park
>djmp at earthlink.net
>http://home.earthlink.net/~djmp/
>
>
>
>
>

Dear David,

it's possible that I miss something..., but look at

In[6]:=
1 - a - Cos[x]^2 /. {1 - Cos[x_]^2 :> Sin[x]^2}
Out[6]=
-a + Sin[x]^2

I don't know what TrigFactor is doing exactly (or intended to do), its
answer might well be consistent with that.


if...
 
In[7]:= expr = f1[a]f2[b]f3[c]f4[d]

...whats wrong with..

In[8]:=
op[#[[{1, 3}]]]op[#[[{2, 4}]]]Take[expr, {5, -1}] &[expr]
Out[8]=
op[f1[a] f3[c]] op[f2[b] f4[d]]

...?


The problem with this of course is, that you must know the Sequence of the
elements of the expression in advance (at programming time). The following
needs not, uses extract and rebuilds the expression (it is assumed the f<i>
are at level {1}, this must be checked, not well done here, just to pass the
idea):

In[7]:=
betteropat[ee : head_[__], {e1_, e3_}, {e2_, e4_}, 
      op_] /; (len = Length[ee]) >= 4 := 
  Module[{pos13 = Position[ee, e1[___] | e3[___], {1}], 
      pos24 = Position[ee, e2[___] | e4[___], {1}], posr},
    posr = List /@ Complement[Range[len], Flatten[{pos13, pos24}]];
    head @@ 
      Join[{op[head @@ Extract[ee, pos13]]}, {op[
            head @@ Extract[ee, pos24]]}, Extract[ee, posr]] ]
In[8]:=
betteropat[expr, {f1, f3}, {f2, f4}, ox]
Out[8]=
ox[f1[a] f3[c]] ox[f2[b] f4[d]]
In[9]:=
betteropat[\[Alpha] f1[a]f4[b]\[Beta] f2[c]f3[d], {f1, f3}, {f2, f4}, ox]
Out[9]=
\[Alpha] \[Beta] ox[f1[a] f3[d]] ox[f2[c] f4[b]]


If you don't need all of this functionality, just reduce.

--
Hartmut


___________________
Addendum:

Here two other solutions, one using Part, the other ReplacePart + Replace:

As to MapAt: (I don't now your Version with Ted Ersek) but mapping at proper
is not possible, since you _must_ reorder your data, not applying a function
at parts of it). Here now another, simpler opat version (using Part, instead
of Extract):

In[19]:=
mapopat[ee : head_[__], {e1_, e3_}, {e2_, e4_}, op_] /; 
    (len = Length[ee]) >= 4 := 
    Block[{pos13 = Flatten[Position[ee, e1[___] | e3[___], {1}]],
           pos24 = Flatten[Position[ee, e2[___] | e4[___], {1}]], posr},
          posr = Complement[Range[len], pos13, pos24];
          head[op[ee[[pos13]]], op[ee[[pos24]]], ee[[posr]]]
         ]

Of course this all is most senseful only for heads with Flat attribute.

In[20]:=
mapopat[expr, {f4, f2}, {f1, f3}, ox]
Out[20]=
ox[f1[a] f3[c]] ox[f2[b] f4[d]]

In[23]:=
mapopat[\[Alpha] f1[a]f4[b]\[Beta] f2[c]f3[d], {f1, f3}, {f2, f4}, ox]
Out[23]=
\[Alpha] \[Beta] ox[f1[a] f3[d]] ox[f2[c] f4[b]]

In[22]:=
mapopat[h[f1[a], f4[b], f2[c], f3[d]], {f1, f3}, {f2, f4}, ox]
Out[22]=
h[ox[h[f1[a], f3[d]]], ox[h[f4[b], f2[c]]], h[]]



finally another version using ReplacePart; not all ReplacePart though, but
in that spirit:


In[99]:=
expr = f1[a]f2[b]f3[c]f4[d]

In[100]:=
rplopat[ee : head_[__], {e1_, e3_}, {e2_, e4_}, op_] 
    /; (len = Length[ee]) >=  4 := 
 Block[{head}, 
    Module[{
      pos = Join @@ (Position[ee, #, {1}] &) /@ Through[{e1, e3, e2,
e4}[___]],
      posr,
      allpos = List /@ Range[len],
      rr},

      posr = Complement[allpos, pos];
      rr = ReplacePart[ee, ee, allpos, Join[pos, posr]];
      Replace[rr, 
        head[a_, b_, c_, d_, r___] :> 
          head[op[head[a, b]], op[head[c, d]], head[r]]]
  ]]

Blocking head prevents reordering (of rr) in case head has the Orderless
attribute.

In[101]:=
rplopat[expr, {f4, f2}, {f1, f3}, ox]
Out[101]=
ox[f1[a] f3[c]] ox[f2[b] f4[d]]

In[103]:=
rplopat[\[Alpha] f1[a]f4[b]\[Beta] f2[c]f3[d], {f1, f3}, {f2, f4}, ox]
Out[103]=
\[Alpha] \[Beta] ox[f1[a] f3[d]] ox[f2[c] f4[b]]

In[104]:=
rplopat[h[f1[a], f4[b], f2[c], f3[d]], {f1, f3}, {f2, f4}, ox]
Out[104]=
h[ox[h[f1[a], f3[d]]], ox[h[f2[c], f4[b]]], h[]]


--
Hartmut


  • Prev by Date: Re: CirclePlus precedence and bigoplus
  • Previous by thread: Operating on Level Subparts of an Expression
  • Next by thread: Assignments