Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I'm reading/studying on my own a book about algebraic curves.

I'm trying to find a way for Mathematica help me with the following (the book, ISBN: 038731802X, allows me to use any CAS / program.

Here is a question:

How many times do the two given curves intersect at the origin?

$\quad(a)\quad y = x^3$

which I can rewrite as $y-x^3 = 0$

$\quad(b)\quad y^4 + 6x^3*y + x^8 == 0 $

I can view both curves using:

ContourPlot[{y^4 + 6 x^3*y + x^8 == 0, y - x^3 == 0}, {x, -5, 5}, {y, -5, 5}]

However, I have no idea how to find the the multiplicity of the zeros at the origin. I'm really stuck.

share|improve this question
    
ContourPlot doesn't show the complete solution, I answered your recent question for the point coordinates in mathematica.stackexchange.com/questions/20281/… –  hieron Aug 16 at 19:33

4 Answers 4

up vote 8 down vote accepted
Count[Solve[y^4 + 6 x^3*y + x^8 == 0 /. {y -> x^3}], {x -> 0}]

(* 6 *)
share|improve this answer
    
belisarius: Thank you very much. I should study the manual. –  Luiz Roberto Meier Aug 16 at 4:34
    
@LuizRobertoMeier Not a bad idea :) –  belisarius Aug 16 at 4:44

General approach

If {x0, y0} is a root of a polynomial system {p1, p2} such that there is no other root of the form {x0, y1}, the multiplicity is given by the multiplicity of the zero x0 of the resultant

Resultant[p1, p2, y]

We can compute the multiplicity of this zero with

SparseArray[
   CoefficientList[Resultant[p1, p2, y] /. x -> x0 + u, u]
 ]["NonzeroPositions"][[1, 1]] - 1

If a root {x0, y0} lines up with another root {x0, y1}, a linear transformation of the variables can always be found so that moves all the other roots off the line x = x0. So in principle, this method can be applied to any system.

OP's example

In the OP's case, the command can be simplified a little since x0 == 0:

SparseArray[
   CoefficientList[Resultant[y^4 + 6 x^3*y + x^8, y^2 - x^3, y], x]
 ]["NonzeroPositions"][[1, 1]] - 1
(*
  6
*)

Comparison

I assume the OP wants a method, not just the answer. (The OP's is simple enough to do, plug in x^3 for y, in one's head after all.) We compare the NSolve method and @belisarius's Solve method with the Resultant method.

My original method was to use NSolve, which seems to work although the docs do not promise that it will, like this if we add Count as @belisarius did:

Count[NSolve[{p1 == 0, p2 == 0}, {x, y}], {x -> 0.`, y -> 0.`}]

Generalizing @belisarius's answer, I would get something like

Count[Solve[p1 == 0 /. #, x, Reals] & /@ Solve[p2 == 0, y] // Flatten, x -> 0]

which indeed yields 6 on the OP's example.

A more difficult example

Now let's consider the system with y^2 replacing y in the second polynomial:

p = {y^4 + 6 x^3*y + x^8, y^2 - x^3};

The two solve-based methods give different answers:

Count[NSolve[p == {0, 0}, {x, y}], {x -> 0.`, y -> 0.`}]
(* 9 *)

Count[Solve[p[[1]] == 0 /. #, x, Reals] & /@ Solve[p[[2]] == 0, y] // Flatten, x -> 0]
(* 10 *)

One solution gets counted twice in the Solve method, I guess, because the Resultant method yields

SparseArray[CoefficientList[Resultant[p[[1]], p[[2]], y], x]]["NonzeroPositions"][[1, 1]] - 1
(* 9 *)

Failure on repeated x0 - and the workaround

If we add some factors to the OP's system so that {x, y} = {0, 1} is a root, all the current solutions fail to yield 6:

p = {(y^4 + 6 x^3*y + x^8) (x^2 + (y - 1)^2), (y - x^3) (y - 1)};

Count[NSolve[p == {0, 0}, {x, y}], {x -> 0.`, y -> 0.`}]
(* 3 *)

Count[Solve[p[[1]] == 0 /. #, x, Reals] & /@ Solve[p[[2]] == 0, y] // 
  Flatten, x -> 0]
(* 8 *)

SparseArray[CoefficientList[Resultant[p[[1]], p[[2]], y], x]]["NonzeroPositions"][[1, 1]] - 1
(* 8 *)

Edit: Actually NSolve gets close, literally. Numerical error leads to three of the roots being slightly off:

Count[Chop[NSolve[p == {0, 0}, {x, y}], 10^-50], {x -> 0, y -> 0}]
(* 6 *)

One can also use the Resultant method by transforming the coordinates so that the root {0, 1} is moved off the line x = 0:

With[{p = p /. {x -> x + y, y -> y}},
 SparseArray[CoefficientList[Resultant[p[[1]], p[[2]], y], x]]["NonzeroPositions"][[1, 1]] - 1]
(* 6 *)

Simply switching x and y also works in this case.


Orginal answer -- NSolve gives the correct multiplicity in V10

NSolve will return the multiplicity, which turns out to be 6 in this case:

NSolve[{y^4 + 6 x^3*y + x^8 == 0, y - x^3 == 0}, {x, y}, Reals]
(*
  {{x -> 0., y -> 0.}, {x -> 0., y -> 0.}, {x -> 0., y -> 0.},
   {x -> 0., y -> 0.}, {x -> 0., y -> 0.}, {x -> 0., y -> 0.}}
*)

(I included a solution using Eliminate but it's not worth the space it would take up.)

share|improve this answer
    
Thank you very much for the help, Michael. –  Luiz Roberto Meier Aug 16 at 2:19
    
@MichaelE2 Could you help me understand why Solve would only return one set of {x -> 0., y -> 0.}? –  seismatica Aug 16 at 5:10
    
@seismatica the command returned the following: {{{x -> 0, y -> 0}, 1}} :( I'm going crazy with this issue. –  Luiz Roberto Meier Aug 16 at 5:26
    
@seismatica I'm using exactly (copy/past) and even typping the exact commands. Only the command of belisarius worked so far. –  Luiz Roberto Meier Aug 16 at 5:30
1  
@LuizRobertoMeier See mathematica.stackexchange.com/questions/18393/… –  Michael E2 Aug 17 at 21:48

You can explicitly see that the degree of intersection at (0,0) is 6 using:

p1 = y - x^3; 
p2 = y^4 + 6 x^3 y + x^8;
Factor[p2 /. y -> x^3]

Also revealing is:

Factor@GroebnerBasis[{p1, p2}, {y, x}]

Giving

{x^6 (x^6+x^2+6), y-x^3}

This result is connected to Bezout's Theorem (covered in your textbook).

share|improve this answer
1  
I like the way you think. –  paw Aug 16 at 20:27

This is not an answer, but is too long for a comment. NSolve produces different results for

NSolve[{y^4 + 6 x^3*y + x^8 == 0, y - x^3 == 0}, {x, y}, Reals]

according to the Mathematica version it is evaluated in.

In V9, it produces

{{x -> 0, y -> 0}}

while in V10 it produces

{{x -> 0., y -> 0.}, {x -> 0., y -> 0.}, {x -> 0., y -> 0.},
 {x -> 0., y -> 0.}, {x -> 0., y -> 0.}, {x -> 0., y -> 0.}}

In my opinion, the V10 result is clearly to be preferred.

share|improve this answer
    
Does Solve have different results between these two versions? I don't have MMA 9 to compare. –  seismatica Aug 16 at 17:51
    
I am with all working fine with my update to V10. Also I notice that in V9 I can get the same answers when I don't explicitly use Reals and instead I use Tally[] and/or Select[] to filter '0.' instead of 0 Also, the study of curves isn't only about (0.,0.) but where n curves will touch m times , including projective geometry (curves / objects / points going to infinity). –  Luiz Roberto Meier Aug 16 at 23:27

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.