home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / sci / math / symbolic / 2244 < prev    next >
Encoding:
Internet Message Format  |  1992-08-20  |  9.2 KB

  1. Path: sparky!uunet!elroy.jpl.nasa.gov!swrinde!gatech!news.ans.net!cmcl2!option!jcao
  2. From: jcao@option.GBA.NYU.EDU (Jingbin Cao)
  3. Newsgroups: sci.math.symbolic
  4. Subject: Mma Solve[] oddity (a much shorter version)
  5. Summary: Solve[] finds roots in a strang way, and may lose roots
  6. Keywords: Solve, oddity
  7. Message-ID: <28914@option.GBA.NYU.EDU>
  8. Date: 21 Aug 92 08:53:21 GMT
  9. Organization: NYU Stern School of Business
  10. Lines: 265
  11.  
  12. The following log documents some weired Solve[] oddities. They are:
  13.  
  14.     1. Solve[] cannot find roots in some cases, at least not within
  15.        reasonable period of time. But if you divide the equations
  16.        by something, Solve[] finds some roots!
  17.     2. Solve[] may lose some roots in the process of finding them,
  18.        even in some trivial cases. So there is no guarrenty that 
  19.        you can get all the roots.
  20.  
  21. I apologize if the log is too long, but I wanted to capture the whole
  22. log.  Viewing it using some editor like emacs is recommended. My
  23. comments quoted by (* *) were added after or during the log.
  24.  
  25. ------------------------------log begin---------------------------------
  26. Mathematica 2.0 for SPARC
  27. Copyright 1988-91 Wolfram Research, Inc.
  28.  -- Terminal graphics initialized -- 
  29.  
  30. In[1]:= u1=-b1 + b2 + 3*n - 3*n*q + 2*x1 + x1^2 - 2*x2 - x2^2
  31.  
  32.                                           2            2
  33. Out[1]= -b1 + b2 + 3 n - 3 n q + 2 x1 + x1  - 2 x2 - x2
  34.  
  35. In[2]:= u2=-b1 + b2 - n + n*q - 2*x1 - 4*n*x1 + 4*n*q*x1 - 3*x1^2 + 2*x2 + 
  36.        4*x1*x2 - x2^2
  37.  
  38.                                                             2
  39. Out[2]= -b1 + b2 - n + n q - 2 x1 - 4 n x1 + 4 n q x1 - 3 x1  + 2 x2 + 
  40.  
  41.                  2
  42. >    4 x1 x2 - x2
  43.  
  44. In[3]:= v1=b1 - b2 + 3*n - 3*n*q + 4*x1 - x1^2 - 4*x2 + x2^2
  45.  
  46.                                          2            2
  47. Out[3]= b1 - b2 + 3 n - 3 n q + 4 x1 - x1  - 4 x2 + x2
  48.  
  49. In[4]:= v2=-b1 + b2 + 5*n - 5*n*q + 4*x1 + x1^2 - 4*x2 - 4*n*x2 + 4*n*q*x2 - 
  50.        4*x1*x2 + 3*x2^2
  51.  
  52.                                           2
  53. Out[4]= -b1 + b2 + 5 n - 5 n q + 4 x1 + x1  - 4 x2 - 4 n x2 + 4 n q x2 - 
  54.  
  55.                    2
  56. >    4 x1 x2 + 3 x2
  57.  
  58. In[5]:= f=u1 u2;
  59.  
  60. In[6]:= g=v1 v2;
  61.  
  62. In[7]:= Timing[sol=Solve[{f==0, g==0}, {x1, x2}]]
  63.  
  64.     (* This is basically what I want to do: to find out all the
  65.        roots for {f==0, g==}. However, some weired things are revealed *)
  66.  
  67. Interrupt> a  (* It took more than a minute of cpu time,
  68.         but the computation is not done. So I aborted it *)
  69.  
  70. Out[7]= $Aborted
  71.  
  72. In[8]:= w=18*(-n + n*q - x1 + x2)^2
  73.  
  74.                                2
  75. Out[8]= 18 (-n + n q - x1 + x2)
  76.  
  77. In[9]:= f=f/w;
  78.  
  79. In[10]:= g=g/w;
  80.  
  81. In[11]:= Timing[sol=Solve[{f==0, g==0}, {x1, x2}]]
  82.  
  83. Out[11]= {19.4667 Second, {{x1 -> 
  84.  
  85.         -8 + 4 Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q]        1
  86. >       --------------------------------------------, x2 -> -}, 
  87.                              8                              2
  88.  
  89.              -8 - 4 Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q]        1
  90. >     {x1 -> --------------------------------------------, x2 -> -}, 
  91.                                   8                              2
  92.  
  93.              -(-15 - 4 b1 + 4 b2 + 20 n - 20 n q)   3 (12 - 16 n + 16 n q)
  94. >     {x1 -> ------------------------------------ - ----------------------, 
  95.                      4 (3 - 4 n + 4 n q)             8 (3 - 4 n + 4 n q)
  96.  
  97.              -(-15 - 4 b1 + 4 b2 + 20 n - 20 n q)
  98. >      x2 -> ------------------------------------}, 
  99.                      4 (3 - 4 n + 4 n q)
  100.  
  101.              1        16 + 4 Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q]
  102. >     {x1 -> -, x2 -> --------------------------------------------}, 
  103.              2                             8
  104.  
  105.              1        16 - 4 Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q]
  106. >     {x1 -> -, x2 -> --------------------------------------------}}}
  107.              2                             8
  108.  
  109.     (* So a little trick brings us five pairs of roots, and it only
  110.        took ~19.5 cpu seconds.
  111.        Why dividing f and g by w helps is beyond my comprehension.
  112.        Now let's have a closer look. *)
  113.  
  114. In[12]:= Table[Factor[u1/.sol[[i]]], {i, 5}]
  115.  
  116.                 (-9 - 4 b1 + 4 b2 + 12 n - 12 n q) (3 - 2 n + 2 n q)
  117. Out[12]= {0, 0, ----------------------------------------------------, 
  118.                                 2 (3 - 4 n + 4 n q)
  119.  
  120.      -36 + 24 n - 24 n q - 12 Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q]
  121. >    --------------------------------------------------------------, 
  122.                                    4
  123.  
  124.      -36 + 24 n - 24 n q + 12 Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q]
  125. >    --------------------------------------------------------------}
  126.                                    4
  127.  
  128. In[13]:= Table[Factor[u2/.sol[[i]]], {i, 5}]
  129.  
  130. Out[13]= {(-9 - 4 b1 + 4 b2 + 12 n - 12 n q + 
  131.  
  132. >       12 Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q] - 
  133.  
  134. >       8 n Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q] + 
  135.  
  136. >       8 n q Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q] - 
  137.  
  138. >       3 (9 + 4 b1 - 4 b2 - 12 n + 12 n q)) / 4, 
  139.  
  140. >    (-9 - 4 b1 + 4 b2 + 12 n - 12 n q - 
  141.  
  142. >       12 Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q] + 
  143.  
  144. >       8 n Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q] - 
  145.  
  146. >       8 n q Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q] - 
  147.  
  148. >       3 (9 + 4 b1 - 4 b2 - 12 n + 12 n q)) / 4, 0, 0, 0}
  149.  
  150. In[14]:= Table[Factor[v1/.sol[[i]]], {i, 5}]
  151.  
  152.           -36 + 24 n - 24 n q + 12 Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q]
  153. Out[14]= {--------------------------------------------------------------, 
  154.                                         4
  155.  
  156.      -36 + 24 n - 24 n q - 12 Sqrt[9 + 4 b1 - 4 b2 - 12 n + 12 n q]
  157. >    --------------------------------------------------------------, 
  158.                                    4
  159.  
  160.      (3 - 2 n + 2 n q) (9 - 4 b1 + 4 b2 - 12 n + 12 n q)
  161. >    ---------------------------------------------------, 0, 0}
  162.                     2 (-3 + 4 n - 4 n q)
  163.  
  164. In[15]:= Table[Factor[v2/.sol[[i]]], {i, 5}]
  165.  
  166. Out[15]= {0, 0, 0, (9 - 4 b1 + 4 b2 - 12 n + 12 n q + 
  167.  
  168. >       12 Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q] - 
  169.  
  170. >       8 n Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q] + 
  171.  
  172. >       8 n q Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q] + 
  173.  
  174. >       3 (9 - 4 b1 + 4 b2 - 12 n + 12 n q)) / 4, 
  175.  
  176. >    (9 - 4 b1 + 4 b2 - 12 n + 12 n q - 
  177.  
  178. >       12 Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q] + 
  179.  
  180. >       8 n Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q] - 
  181.  
  182. >       8 n q Sqrt[9 - 4 b1 + 4 b2 - 12 n + 12 n q] + 
  183.  
  184. >       3 (9 - 4 b1 + 4 b2 - 12 n + 12 n q)) / 4}
  185.  
  186. (* So,
  187.     sol[[1]], sol[[2]] are solutions to {u1==0, v2==0},
  188.     sol[[3]]        is  solution  to {u2==0, v2==0}, and
  189.     sol[[4]], sol[[5]] are solutions to {u2==0, v1==0}.
  190.  
  191.    Now, some more questions:
  192.     Q1: Is there solution to {u1==0, v1==0}?
  193.     Q2: Is there _other_ solution to {u2==0, v2==0}?
  194.     Q3: Is there _other_ solution to {u1==0, v2==0} or {u2==0, v1==0}?
  195. *)
  196.  
  197. In[16]:= Timing[sol1=Solve[{u1==0, v1==0}, {x1, x2}]] (* for Q1 *)
  198.  
  199. Out[16]= {0.4 Second, {{x1 -> 
  200.  
  201.                                                       2            2      2  2
  202.         -((n - n q) (-2 n + 2 n q))   -b1 + b2 + n + n  - n q - 2 n  q + n  q
  203. >       --------------------------- - ----------------------------------------
  204.                2 (-n + n q)                         2 (-n + n q)
  205.  
  206.                                   2            2      2  2
  207.                 -(-b1 + b2 + n + n  - n q - 2 n  q + n  q )
  208. >       , x2 -> -------------------------------------------}}}
  209.                                2 (-n + n q)
  210.  
  211.     (* So we find one more pair of roots for {u1==0, v1==0} *)
  212.  
  213. In[17]:= Timing[sol1=Solve[{u1==0, v2==0}, {x1, x2}]] (* for Q2 *)
  214.  
  215. Interrupt> a  (* I have to abort it again because it had taken
  216.         more than 7 cpu minutes *)
  217.  
  218. Out[17]= $Aborted
  219.  
  220.     (* Now let's look at Q3 *)
  221.  
  222. In[18]:= Timing[sol1=Solve[{u2==0, v2==0}, {x1, x2}]] 
  223.  
  224. Out[18]= {31.8333 Second, {{x1 -> 
  225.  
  226.                                           9
  227. >       (-5 + 10 n - 10 n q + ------------------------- - 
  228.                               (1 - q) (3 - 4 n + 4 n q)
  229.  
  230.     ......................
  231.  
  232.     (* the output is way too long and I have to delete it.
  233.        the roots are simplified in In[21] *)
  234.  
  235. In[19]:= sol2=sol1; sol1=%16; (* let me correct my mistake first *)
  236.  
  237. In[20]:= Table[{Factor[x1/.sol2[[i]]], factor[x2/.sol2[[i]]]}, {i, 2}]
  238.  
  239. General::spell1: 
  240.    Possible spelling error: new symbol name "factor"
  241.      is similar to existing symbol "Factor".
  242.  
  243. Interrupt> a     (* opps, another mistake *)
  244.  
  245. Out[20]= $Aborted
  246.  
  247. In[21]:= Table[{Factor[x1/.sol2[[i]]], Factor[x2/.sol2[[i]]]}, {i, 2}]
  248.  
  249.            -3 + 4 b1 - 4 b2 + 4 n - 4 n q
  250. Out[21]= {{------------------------------, 
  251.                 4 (3 - 4 n + 4 n q)
  252.  
  253.       -15 - 4 b1 + 4 b2 + 20 n - 20 n q
  254. >     ---------------------------------}, 
  255.             4 (-3 + 4 n - 4 n q)
  256.  
  257.                      2            2      2  2
  258.       b1 - b2 - n + n  + n q - 2 n  q + n  q
  259. >    {---------------------------------------, 
  260.                    2 n (-1 + q)
  261.  
  262.                       2            2      2  2
  263.       -b1 + b2 + n + n  - n q - 2 n  q + n  q
  264. >     ----------------------------------------}}
  265.                     2 n (1 - q)
  266.  
  267. In[22]:= (* So we find one more pair of roots for {u2==0, v2==0}
  268.  
  269.     What are my conclusions of this exercise?
  270.  
  271.     1. Solve[] cannot find roots in some cases, at least not within
  272.        reasonable period of time. But if you divide the equations
  273.        by something, Solve[] finds some roots!
  274.     2. Solve[] may lose some roots in the process of finding them,
  275.        even in some trivial cases. *)
  276. ---------------------------------log ends---------------------------------
  277.