Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2007

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

Search the Archive

Re: RE: greetings and a question!

  • To: mathgroup at smc.vnet.net
  • Subject: [mg83220] Re: [mg83136] RE: [mg83116] greetings and a question!
  • From: DrMajorBob <drmajorbob at bigfoot.com>
  • Date: Thu, 15 Nov 2007 05:40:06 -0500 (EST)
  • References: <33259982.1194871140629.JavaMail.root@m35> <op.t1oxw8wuqu6oor@monster.gateway.2wire.net>
  • Reply-to: drmajorbob at bigfoot.com

Here's a partial explanation of what Reduce does (I suspect) when  
calculating:

lhs = x^2 + y^2 + (a + b)*x - (a - b)*y + a^2 + b^2 - a - b + 1;
Reduce[lhs == 0, {a, b, x, y}, Reals]

a == 1 && b == 1 && x == -1 && y == 0

First consider the discriminants of lhs with respect to x, y, a, and b:

Discriminant[lhs, {x, y, a, b}]

{-4 + 4 a - 3 a^2 + 4 b + 2 a b - 3 b^2 + 4 a y - 4 b y - 4 y^2, -4 +
   4 a - 3 a^2 + 4 b - 2 a b - 3 b^2 - 4 a x - 4 b x - 4 x^2, -3 +
   4 b - 4 b^2 - 2 x - 4 b x - 3 x^2 + 2 y - 4 b y - 2 x y -
   3 y^2, -3 + 4 a - 4 a^2 - 2 x - 4 a x - 3 x^2 - 2 y + 4 a y +
   2 x y - 3 y^2}

Taking just the first for illustration, this means that

x /. Solve[lhs == 0, x];
Subtract @@ %;
%^2 // Expand

-4 + 4 a - 3 a^2 + 4 b + 2 a b - 3 b^2 + 4 a y - 4 b y - 4 y^2

(Read the documentation for Discriminant. The above is simplified based on  
knowing that Solve gives exactly two solutions.)

If the solution is unique (the only case I'll try to explain), all four
discriminants must be zero. (Loosely speaking. Let an expert speak up and  
clarify, if he likes.) Documentation says that CylindricalDecomposition =

uses Groebner basis methods when the solution is zero-dimensional, so I'll  
try to do the same.

So {x, y, a, b} must be roots of the following polynomials:

Column[gb=GroebnerBasis@Discriminant[lhs,{x,y,a,b}]]

1+4 x+6 x^2+4 x^3+x^4
y^2+2 x y^2+x^2 y^2
y+3 x y+3 x^2 y+x^3 y+y^3+x y^3
y^4
9+18 b+45 x+36 b x+63 x^2+18 b x^2+27 x^3+y+2 x y+x^2 y+12 y^2+12 x y^2- 12  
y^3
-3-9 x-9 x^2-3 x^3-5 y+12 b y+2 x y+12 b x y+7 x^2 y+7 y^2+7 x y^2-3 y^3
-12-36 x-36 x^2-12 x^3+12 y+24 x y+12 x^2 y-17 y^2+18 b y^2+x y^2+27 y^3
3-4 b+4 b^2+2 x+4 b x+3 x^2-2 y+4 b y+2 x y+3 y^2
9+18 a+45 x+36 a x+63 x^2+18 a x^2+27 x^3-y-2 x y-x^2 y+12 y^2+12 x y^2+12  
y^3
-1-2 a-2 b-6 x-2 a x-2 b x-5 x^2+2 a y-2 b y-5 y^2
1+2 a+2 b+2 a b+6 x+4 a x+4 b x+7 x^2+3 y^2
1-8 a+4 a^2-4 b-10 x-4 b x-7 x^2+2 y-4 b y-2 x y-7 y^2

y == 0 is the only root of the fourth polynomial, and we can use that to  
simplify:

Column[gb2=GroebnerBasis@DeleteCases[gb/.y->0,0]]
-1+3 a-3 a^2+a^3
-1+2 a-a^2+b-2 a b+a^2 b
4-4 a+3 a^2-4 b-2 a b+3 b^2
1-3 a+2 a^2-b+a b-2 x+2 a x
-5+5 a-6 a^2-b+7 a b-6 x+6 b x
1+2 a+2 b-2 a b+6 x+3 x^2

We look for an equation with only one variable (the first) and get

Solve[0 == gb2[[1]], a]

{{a -> 1}, {a -> 1}, {a -> 1}}

Simplify again:

Column[gb3=GroebnerBasis@DeleteCases[gb2/.a->1,0]]
1+2 x+x^2
-1+b-x+b x
1-2 b+b^2

Solve the first:

Solve[0 == gb3[[1]], x]

{{x -> -1}, {x -> -1}}

Simplify:

Column[gb4=GroebnerBasis@DeleteCases[gb3/.x->-1,0]]
1-2 b+b^2

Solve:

Solve[0 == gb4[[1]], b]

{{b -> 1}, {b -> 1}}

And we've reached the same solution as Reduce or CylindricalDecomposition.

I don't know how generally applicable that process might be, but it's  
interesting!

Bobby

On Mon, 12 Nov 2007 12:06:34 -0600, DrMajorBob <drmajorbob at bigfoot.com> 
wrote:

> The methods of Reduce are mysterious, but I can, at least, verify that 
> the result is correct and unique. Start by solving for x and looking at 

> the term inside Sqrt:
>
> xRoots = x /. Solve[eq, x];
> xDiscriminant = First@Union@Cases[xRoots, Sqrt[z_] :> z, Infinity]
>
> -4 + 4 a - 3 a^2 + 4 b + 2 a b - 3 b^2 + 4 a y - 4 b y - 4 y^2
>
> For x to be Real, this must be >= 0. To have more than one solution, it  
> must be > 0, which Reduce says is impossible:
>
> Reduce[xDiscriminant > 0, {a, b, y, z}, Reals]
>
> False
>
> It can be 0, however, at precisely the values you originally posted:
>
> Reduce[xDiscriminant == 0, {a, b, y, z}, Reals]
> xRoots /. ToRules@%
>
> a == 1 && b == 1 && y == 0
>
> {-1, -1}
>
> To show that Reduce is correct about that "False" pronouncement above, 
> we mimic the above steps, this time solving for y to factor the x  
> discriminant:
>
> yRoots = y /. Solve[xDiscriminant == 0, y];
> yDiscriminant = Last@Union@Cases[yRoots, Sqrt[z_] :> z, Infinity]
>
> -2 + 2 a - a^2 + 2 b - b^2
>
> As before, the discriminant must be >= 0 to allow a Real y value, and >  
> 0 to allow more than one.
>
> But
>
> 0 == yDiscriminant + (b - 1)^2 + (a - 1)^2 // Expand
>
> True
>
> so a = b = 1 is the only real solution.
>
> Bobby
>
> On Mon, 12 Nov 2007 04:18:15 -0600, Tony Harker <a.harker at ucl.ac.uk>  
> wrote:
>
>> Rearrange the expression as
>>
>>   (((x + 1) + (a + b - 2)/2)^2 + (y - (a - b)/2)^2) + ((a - 1)^2)/
>>   2 + ((b - 1)^2/)2,
>>
>>  which, if a, b, x and y are real, can only be zero if each term is  
>> zero.
>> The result follows.
>>
>>   As to how Mathematica does it -- over to the experts!
>>
>>    Tony
>>
>> A.H. Harker
>> 112 Cumnor Hill
>> Oxford
>> OX2 9HY
>> UK
>>
>> ]-> -----Original Message-----
>> ]-> From: dimitris [mailto:dimmechan at yahoo.com]
>> ]-> Sent: 11 November 2007 08:03
>> ]-> To: mathgroup at smc.vnet.net
>> ]-> Subject: [mg83116] greetings and a question!
>> ]->
>> ]-> Hello to all of you!
>> ]->
>> ]-> Unfortunately, family, working and research issues prevent
>> ]-> me from participating to the forum as frequent as I used to.
>> ]->
>> ]-> Anyway...
>> ]->
>> ]-> It is my first post since a long time so everybody be patient!
>> ]->
>> ]-> A student of mine came across the following equation in a
>> ]-> mathematical contest:
>> ]->
>> ]-> In[1]:=
>> ]-> eq = x^2 + y^2 + (a + b)*x - (a - b)*y + a^2 + b^2 - a - b + 1==
=0;
>> ]->
>> ]-> (all variables are assumed real)
>> ]->
>> ]-> Of course for Mathematica the solution is rather trivial.
>> ]->
>> ]-> In[1]:=
>> ]-> $Version
>> ]->
>> ]-> Out[1]=
>> ]-> "5.2 for Microsoft Windows (June 20, 2005)"
>> ]->
>> ]-> In[2]:=
>> ]-> eq = x^2 + y^2 + (a + b)*x - (a - b)*y + a^2 + b^2 - a - b + 1==
=0;
>> ]->
>> ]-> In[3]:=
>> ]-> Reduce[eq, {a, b, x, y}, Reals]
>> ]-> ToRules[%]
>> ]-> eq /. %
>> ]->
>> ]-> Out[3]=
>> ]-> a == 1 && b == 1 && x == -1 && y == 0
>> ]->
>> ]-> Out[4]=
>> ]-> {a -> 1, b -> 1, x -> -1, y -> 0}
>> ]->
>> ]-> Out[5]=
>> ]-> True
>> ]->
>> ]-> Can somebody explain concisely the mathematica concept
>> ]-> behind this solution? In fact I would be much obliged if
>> ]-> somebody pointed me out how to obtain the result by hand.
>> ]-> Also, by curiosity, how Mathematica reaches the result?
>> ]->
>> ]-> Dimitris
>> ]->
>> ]->
>> ]->
>>
>>
>>
>
>
>



-- =

DrMajorBob at bigfoot.com


  • Prev by Date: Re: Solving simple equations
  • Next by Date: Floor doesn't compute in some cases
  • Previous by thread: Re: RE: greetings and a question!
  • Next by thread: WeightingFunction and Showing Graphs with wieghts as Edge Lable