MathGroup Archive 2010

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

Search the Archive

Re: Parametrized assumptions

  • To: mathgroup at smc.vnet.net
  • Subject: [mg107942] Re: [mg107828] [mg107828] Parametrized assumptions
  • From: Daniel Lichtblau <danl at wolfram.com>
  • Date: Wed, 3 Mar 2010 05:52:56 -0500 (EST)
  • References: <201002270817.DAA12061@smc.vnet.net>

Torsten Schoenfeld wrote:
> I'm having trouble using parametrized assumptions consistently.  I have 
> two objects, q and r, both having a label and an index.  Now, I want 
> that the following holds for any label L:
> 
>    q[L, 0]^2 - q[L, 1]^2 == 1
>    q[L, 0] r[L, 0] - q[L, 1] r[L, 1] == t[L]
> 
> For the first condition, I find that the following works
> 
>    Assuming[1 == HoldPattern[q[l_, 0]^2 - q[l_, 1]^2],
>      q[w, 0]^2 - q[w, 1]^2 // Simplify]
>    -> 1
> 
> The HoldPattern[] is, apparently, necessary, and it also needs to be 
> only on the right hand side.  However, I can't find a way to realize the 
> second condition.  My attempts include
> 
>    Assuming[t[l_] == HoldPattern[q[l_, 0] r[l_, 0] - q[l_, 1] r[l_, 1]],
>      q[w, 0] r[w, 0] - q[w, 1] r[w, 1] // Simplify]
> 
>    Assuming[HoldPattern[t[l_] == q[l_, 0] r[l_, 0] - q[l_, 1] r[l_, 1]],
>      q[w, 0] r[w, 0] - q[w, 1] r[w, 1] // Simplify]
> 
>    Assuming[0 == HoldPattern[q[l_, 0] r[l_, 0] - q[l_, 1] r[l_, 1] - t[l_]],
>      q[w, 0] r[w, 0] - q[w, 1] r[w, 1] // Simplify]
> 
> None of these work.  I assume part of the problem is that I don't 
> understand why this doesn't work:
> 
>    q[w, 0] r[w, 0] - q[w, 1] r[w, 1] /.
>      HoldPattern[q[l_, 0] r[l_, 0] - q[l_, 1] r[l_, 1]] -> a
> 
> Whereas this works:
> 
>    q[w, 0] r[w, 0] - q[w, 1] r[w, 1] /.
>      q[l_, 0] r[l_, 0] - q[l_, 1] r[l_, 1] -> a
> 
> So, how do I go about implementing these kinds of parametrized assumptions?

Might use Cases to grab the variables of interest, then PolynomialReduce 
to do reductions. Here is an example.

q0vars[ee_] := Union[Cases[ee, q[_,0], Infinity]]

expr = q[x,0]^4-q[y,0]^3*q[x,0]*q[x,1]+q[y,0]^2*r[x,0]*r[y,0]

In[19]:= qv = q0vars[expr]
Out[19]= {q[x, 0], q[y, 0]}

 From these we form the "reducing" polynomials.

redpolys = Apply[Join,Map[{
   #^2 - (#/.q[a_,0]->q[a,1])^2 - 1,
   With[{qr=#*(#/.q->r)},
     qr - (qr/.a_[b_,0]->a[b,1]) - t[#[[1]]]]}&, qv]];

In[22]:= InputForm[Last[
   PolynomialReduce[expr, redpolys, qv, CoefficientDomain->Rationals]]]
Out[22]//InputForm=
1 + 2*q[x, 1]^2 + q[x, 1]^4 - q[x, 0]*q[x, 1]*q[y, 0] -
  q[x, 0]*q[x, 1]*q[y, 0]*q[y, 1]^2 + r[x, 0]*r[y, 0] +
  q[y, 1]^2*r[x, 0]*r[y, 0]

We now have no terms of power larger than one in the "lead" variables 
q[x,1] and q[y,0], and no terms involving q[a_,0] times r[a,0].

Depending on what exactly you want to do, you may need to adjust this a bit.

Daniel Lichtblau
Wolfram Research




  • Prev by Date: Re: Re: Shading in polar plot
  • Next by Date: Re: Modification of Variable in NDSolve
  • Previous by thread: Remote kernels over SSH
  • Next by thread: Write an expression in a specific form