=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/lib/sturm,v retrieving revision 1.2 retrieving revision 1.4 diff -u -p -r1.2 -r1.4 --- OpenXM_contrib2/asir2000/lib/sturm 2000/08/21 08:31:43 1.2 +++ OpenXM_contrib2/asir2000/lib/sturm 2001/04/03 04:41:24 1.4 @@ -23,7 +23,7 @@ * shall be made on your publication or presentation in any form of the * results obtained by use of the SOFTWARE. * (4) In the event that you modify the SOFTWARE, you shall notify FLL by - * e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification + * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification * for such modification or the source code of the modified part of the * SOFTWARE. * @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/lib/sturm,v 1.1.1.1 1999/12/03 07:39:11 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/lib/sturm,v 1.3 2000/08/22 05:04:23 noro Exp $ */ /* find intervals which include roots of a polynomial */ @@ -159,5 +159,38 @@ def numch0(S,V,A,T) { T = T1; } return C; +} + +def count_real_roots(F) +{ + if ( type(F) == 1 ) + return 0; + V = var(F); + R = 0; + /* remove three roots : -1, 0, 1 */ + if ( Q = tdiv(F,V) ) { + F = Q; R++; + while ( Q = tdiv(F,V) ) + F = Q; + } + if ( Q = tdiv(F,V-1) ) { + F = Q; R++; + while ( Q = tdiv(F,V-1) ) + F = Q; + } + if ( Q = tdiv(F,V+1) ) { + F = Q; R++; + while ( Q = tdiv(F,V+1) ) + F = Q; + } + if ( type(F) == 1 ) + return R; + S = sturm(F); + /* number of roots in [-1,1] */ + R += numch(S,V,-1)-numch(S,V,1); + RS = sturm(ureverse(F)); + /* number of roots in [-inf,-1] \cup [1,inf] */ + R += numch(RS,V,-1)-numch(RS,V,1); + return R; } end;