Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
802 lines (732 sloc) 20.9 KB
%%HP: T(0)A(D)F(.);
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ buchberger.rpl -- Buchberger algorithm implementation
@
@ Copyright (C) 2017 Bruno Felix Rezende Ribeiro <oitofelix@@gnu.org>
@
@ This program is free software; you can redistribute it and/or modify
@ it under the terms of the GNU General Public License as published by
@ the Free Software Foundation; either version 3, or (at your option)
@ any later version.
@
@ This program is distributed in the hope that it will be useful,
@ but WITHOUT ANY WARRANTY; without even the implied warranty of
@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
@ GNU General Public License for more details.
@
@ You should have received a copy of the GNU General Public License
@ along with this program. If not, see <http://www.gnu.org/licenses/>.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
DIR
$TITLE "BUCHBERGER (8FKERNEL)"
$ROMID 770.
$CONFIG
«
HOME $ROMID ATTACH
»
$EXTPRG '$EXT'
$EXT
«
$HELP LIBHELPVIEW
»
$VISIBLE
{
STOPOLYVX RCLPOLYVX STOPOLYORD RCLPOLYORD
PLEX PREVLEX PGRLEX PGREVLEX PORDER
MDEG TDEG LCOEF LMONO LTERM PDIV SPOLY
MONOMIALS POLYEQ POSPOLY POSPOLYPAIR BUCHBERGER
PDIVORDER
}
$HIDDEN
{
$ROMID $HELP $EXT
$PORDER $COEF $MONOLIST $LISTMONO $POLYLIST
$LISTPOLY $MONODIV $MONOLCM $POLYINT
$BuchDisp
$NormalForm
$ReduceAll
$SelStrategy
$NewBasis
$Criterion1
$Criterion2
}
$MESSAGE
{
@1@ "Division by null polynomial"
}
$HELP
{
TDEG "This is help for TDEG. And such things!"
MDEG "This is help for MDEG."
}
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ STOPOLYVX
@
@ {names} 
@
@ Stores a list of variable names in the POLYVX CAS variable. This is the same
@ as storing into the POLYVX variable in the CASDIR directory. By default, the
@ CAS variable list is {X}. All variable names therein (and only those) are
@ regarded by the CAS as symbolic polynomial variables. The order they are
@ listed determines the variable's ordering used by the CAS. Variable names
@ should be listed in descending order.
@
@ See: RCLPOLYVX STOPOLYORD
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
STOPOLYVX
«
PUSH HOME CASDIR 'POLYVX' STO POP
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ RCLPOLYVX
@
@ 
@
@ Returns the list of names stored in the POLYVX CAS variable. This is the
@ same action as recalling the contents of the variable POLYVX in the CASDIR
@ directory, except by the fact that if this variable does not exist the {X}
@ default is returned.
@
@ See: STOPOLYVX
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
RCLPOLYVX
«
IFERR :H:{CASDIR POLYVX} RCL THEN DROP {X} END
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ STOPOLYORD
@
@ « program » 
@
@ Stores an internal monomial list representation comparison function in the
@ POLYORD CAS variable. This is the same as storing into the POLYORD variable
@ in the CASDIR directory. By default, the CAS monomial comparison function is
@ « PLEX ». The following comparison functions are already implemented for
@ use: PLEX, PREVLEX, PGRLEX and PGREVLEX. The user may want implement his
@ own, though.
@
@ See: RCLPOLYORD STOPOLYVX PLEX PREVLEX PGRLEX PGREVLEX
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
STOPOLYORD
«
PUSH HOME CASDIR 'POLYORD' STO POP
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ RCLPOLYORD
@
@ 
@
@ Returns the internal monomial list representation comparison function stored
@ in the POLYORD CAS variable. This is the same action as recalling the
@ contents of the variable POLYORD in the CASDIR directory, except by the fact
@ that if this variable does not exist the « PLEX » default is returned.
@
@ See: STOPOLYORD
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
RCLPOLYORD
«
IFERR :H:{CASDIR POLYORD} RCL THEN DROP «PLEX» END
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ TDEG
@
@ polynomial  integer
@
@ Returns the total degree of a polynomial expression. This is defined as the
@ maximum of the sums of the exponents of each monomial in the expression.
@ If the polynomial is zero, returns an undefined negative number.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
TDEG
«
$POLYLIST 1. «TAIL SUMLIST» DOLIST «MAX» STREAMLIST
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ MDEG
@
@ polynomial  integer
@
@ Returns the multidegree of a polynomial expression. This is defined as the
@ n-tuple of exponents of the maximum monomial.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
MDEG
«
$POLYLIST $PORDER DUP SIZE GET TAIL
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ LCOEF
@
@ polynomial  number
@
@ Returns the leading coefficient of a polynomial expression. This is defined
@ as the coefficient of the maximum monomial.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
LCOEF
«
$POLYLIST $PORDER DUP SIZE GET HEAD
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ LMONO
@
@ polynomial  monomial
@
@ Returns the leading monomial of a polynomial expression. This is defined
@ as the maximum monomial times the inverse of its coefficient.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
LMONO
«
$POLYLIST $PORDER DUP SIZE GET TAIL 1 SWAP + $LISTMONO
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ LTERM
@
@ polynomial  monomial
@
@ Returns the leading term of a polynomial expression. This is defined
@ as the maximum monomial.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
LTERM
«
$POLYLIST $PORDER DUP SIZE GET $LISTMONO
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $PORDER
@
@ {list_polynomial1}  {list_polynomial2}
@
@ Increasingly orders an internal polynomial list representation in respect to
@ the internal monomial list representation comparison function given by the
@ POLYORD CAS variable.
@
@ See: PORDER
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$PORDER
«
RCLPOLYORD QUICKSORT
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PORDER
@
@ polynomial1  polynomial2
@
@ Increasingly orders a polynomial in respect to the internal monomial list
@ representation comparison function given by the POLYORD CAS variable.
@
@ See: STOPOLYORD $PORDER
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PORDER
«
$POLYLIST $PORDER $LISTPOLY
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PLEX
@
@ A B
@ {c1 e11 ... e1n} {c2 e21 ... e2n}  int
@
@ Lexicographic order comparison for internal monomial list representation.
@ In this order, A>B if the leftmost nonzero entry of the list
@ {e11-e21 ... e1n-e2n} is positive, A<B if it is negative, and A=B in case
@ there is no such entry.
@
@ See: QUICKSORT $MONOLIST
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PLEX
«
TAIL SWAP TAIL SWAP - 1.
WHILE GETI DUP NOT -64. FC? AND REPEAT DROP END
UNROT DROP2
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PREVLEX
@
@ A B
@ {c1 e11 ... e1n} {c2 e21 ... e2n}  int
@
@ Reverse lexicographic order comparison for internal monomial list
@ representation. In this order, A>B if the rightmost nonzero entry of the list
@ {e11-e21 ... e1n-e2n} is negative, A<B if it is positive, and A=B in case
@ there is no such entry.
@
@ See: QUICKSORT $MONOLIST
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PREVLEX
«
TAIL SWAP TAIL SWAP - REVLIST 1.
WHILE GETI DUP NOT -64. FC? AND REPEAT DROP END
UNROT DROP2 NEG
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PGRLEX
@
@ A B
@ {c1 e11 ... e1n} {c2 e21 ... e2n}  int
@
@ Graded lexicographic order comparison for internal monomial list
@ representation. In this order, A>B if e11+...+e1n>e21+...+e2n, or
@ e11+...+e1n=e21+...+e2n and PLEX(A,B)>0.
@
@ See: QUICKSORT $MONOLIST PLEX
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PGRLEX
«
IF DUP2 TAIL SUMLIST SWAP TAIL SUMLIST SWAP - DUP
THEN UNROT DROP2
ELSE DROP PLEX
END
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PGREVLEX
@
@ A B
@ {c1 e11 ... e1n} {c2 e21 ... e2n}  int
@
@ Graded reverse lexicographic order comparison for internal monomial list
@ representation. In this order, A>B if e11+...+e1n>e21+...+e2n, or
@ e11+...+e1n=e21+...+e2n and PREVLEX(A,B)>0.
@
@ See: QUICKSORT $MONOLIST PLEX
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PGREVLEX
«
IF DUP2 TAIL SUMLIST SWAP TAIL SUMLIST SWAP - DUP
THEN UNROT DROP2
ELSE DROP PREVLEX
END
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $COEF
@
@ monomial  number
@
@ Returns the coefficient of a monomial.
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$COEF
«
RCLPOLYVX 1 OVER SIZE NDUPN LIST PAIRLIST | EVAL
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $MONOLIST
@
@ monomial  {c e1 ... en}
@
@ Converts a monomial to the internal monomial list representation.
@ In this representation the first element is the monomial's coefficient and
@ subsequent elements are the powers of the monomial's variables declared in
@ the CAS POLYVX variable, in the order defined thereof.
@
@ See: STOPOLYVX $LISTMONO
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$MONOLIST
«
RCLVX NOVAL  M VXB M.LNAME
«
M $COEF
M LNAME NIP
IF DUP TYPE 5. ‹ THEN AXL END
'M.LNAME' STO
RCLPOLYVX 1.
DO GETI
IF DUP M.LNAME SWAP POS
THEN STOVX M DEGREE
ELSE DROP 0
END UNROT
UNTIL -64. FS? END
DROP SIZE 1. + LIST
VXB STOVX
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $LISTMONO
@
@ {c e1 ... en}  monomial
@
@ Converts internal monomial list representation back to an actual monomial.
@
@ See: $LISTMONO
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$LISTMONO
«
DUP HEAD SWAP RCLPOLYVX SWAP TAIL ^ PRODLIST *
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $POLYLIST
@
@ polynomial  {{c1 e11 ... e1n} ... {cm em1 ... emn}}
@
@ Converts a polynomial to the internal polynomial list representation. This
@ representation is just a list of monomials in the internal monomial list
@ representation as described in $MONOLIST.
@
@ See: $LISTPOLY $MONOLIST
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$POLYLIST
«
NOVAL 1. NOVAL NOVAL  P L I A B
«
P FDISTRIB STR "+" "''" SREPL DROP "(" "" SREPL DROP ")" "" SREPL DROP
"{" SWAP + "}" + STR
1. '$MONOLIST' DOLIST
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $LISTPOLY
@
@ {{c1 e11 ... e1n} ... {cm em1 ... emn}}  polynomial
@
@ Converts internal polynomial list representation back to an actual
@ polynomial.
@
@ See: $POLYLIST
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$LISTPOLY
«
1. « $LISTMONO » DOLIST SUMLIST
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $MONODIV
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$MONODIV
«
$MONOLIST TAIL SWAP $MONOLIST TAIL - 1.
WHILE GETI DUP 0. Š -64. FC? AND REPEAT DROP END
0. Š UNROT DROP2
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ MONOMIALS
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
MONOMIALS
«
 p
«
p $POLYLIST 1. « $LISTMONO » DOLIST
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PDIV
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PDIV
«
@P@ @input@
@D@ @input@
@Q@ NOVAL
@R@ 0
@I@ NOVAL
@M@ NOVAL
@D.SIZE@ NOVAL
@I.D.LTERM@ NOVAL
@P.LTERM@ NOVAL

@Input 1: polynomial@ P
@Input 2: {divisors}@ D
@Output 1: {quotients}@ Q
@Output 3: {remainder}@ R
@{divisors} index@ I
@Division occurred (flag)@ M
@SIZE(D)@ D.SIZE
@LTERM(D(I))@ I.D.LTERM
@LTERM(P)@ P.LTERM
«
D SIZE 'D.SIZE' STO
0 D.SIZE NDUPN LIST 'Q' STO
WHILE P 0 SAME NOT REPEAT
1. 'I' STO
0. 'M' STO
WHILE I D.SIZE ‰ M NOT AND REPEAT
'D' I GET LTERM 'I.D.LTERM' STO
P LTERM 'P.LTERM' STO
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
I.D.LTERM 10 CHR + P.LTERM + 1. DISP
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
IF I.D.LTERM 0 SAME NOT
I.D.LTERM P.LTERM $MONODIV AND THEN
'Q' I DUP2 GET P.LTERM I.D.LTERM / + EVAL PUT
P P.LTERM I.D.LTERM / 'D' I GET * - EVAL 'P' STO
1. 'M' STO
ELSE
1. 'I' STO+
END
END
IF M NOT THEN
R P.LTERM + EVAL 'R' STO
P P.LTERM - EVAL 'P' STO
END
END
Q R
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $MONOLCM
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$MONOLCM
«
 m1 m2
«
m1 $MONOLIST TAIL
m2 $MONOLIST TAIL
« MAX » DOLIST 1 SWAP + $LISTMONO
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ SPOLY
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
SPOLY
«
NOVAL NOVAL NOVAL  p1 p2 lt1 lt2 lcm
«
IF p1 0 SAME p2 0 SAME OR THEN $ROMID #1d LIBDOERR END
@ compute leading term (list form)
p1 LTERM 'lt1' STO
p2 LTERM 'lt2' STO
@ compute least common multiple of the leading terms
lt1 lt2 $MONOLCM 'lcm' STO
@ compute S-polynomial
lcm lt1 / p1 *
lcm lt2 / p2 *
- EVAL
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $POLYINT
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$POLYINT
«
 P
«
P MONOMIALS 1. « $COEF FXND » DOLIST UNPAIRLIST
« LCM » STREAMLIST SWAP
« GCD » STREAMLIST /
ABS P LCOEF SIGN *
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ POLYEQ
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
POLYEQ
«
- EVAL 0 SAME
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ POSPOLY
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
POSPOLY
«
0. 0.  l p r l.SIZE
«
l SIZE 'l.SIZE' STO
IF l.SIZE 0. > THEN
1. l.SIZE
FOR I
IF 'l' I GET p POLYEQ THEN
I 'r' STO
l.SIZE 'I' STO+
END
NEXT
END
r
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ POSPOLYPAIR
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
POSPOLYPAIR
«
0. 0. 0 0 0 0  l p r l.SIZE p1 p2 lp1 lp2
«
p {'p1' 'p2'} STO
l SIZE 'l.SIZE' STO
IF l.SIZE 0. > THEN
1. l.SIZE
FOR I
'l' I GET {'lp1' 'lp2'} STO
IF p1 lp1 POLYEQ p2 lp2 POLYEQ AND
p1 lp2 POLYEQ p2 lp1 POLYEQ AND OR
THEN
I 'r' STO
l.SIZE 'I' STO+
END
NEXT
END
r
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ BUCHBERGER
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
BUCHBERGER
«
{} {} {} 0 0 0  ŽR ŽP ŽG ŽB f1 f2 h
«
@@@@@@@@@@@@@@@@@@@
CLLCD
@@@@@@@@@@@@@@@@@@@
$ReduceAll $NewBasis
WHILE ŽB {} ‹ REPEAT
$BuchDisp
ŽB HEAD {'f1' 'f2'} STO
ŽB TAIL 'ŽB' STO
IF f1 f2 $Criterion1 NOT
f1 f2 $Criterion2 NOT AND
THEN
ŽG f1 f2 SPOLY $NormalForm 'h' STO
IF h 0 SAME NOT THEN
ŽG 1. «  g « IF h LTERM g LTERM $MONODIV THEN g END » » DOLISTX 'ŽR' STO
h 1. LIST 'ŽP' STO
ŽG 1. «  g « IF ŽR g POSPOLY NOT THEN g END » » DOLISTX 'ŽG' STO
ŽB 1. «  b « IF ŽR b HEAD POSPOLY ŽR b TAIL POSPOLY OR NOT THEN b END » »
DOLISTX 'ŽB' STO
$ReduceAll $NewBasis
END
END
END
IF ŽG {} SAME THEN {0}
ELSE ŽG 1. « DUP $POLYINT * EVAL » DOLIST
END
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $BuchDisp
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$BuchDisp
«
"Remaining: " ŽB SIZE RI + 8. DISP
"Memory: " MEM + 9. DISP
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ PDIVORDER
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
PDIVORDER
«
 p1 p2
«
p1 $POLYLIST $PORDER DUP SIZE GET
p2 $POLYLIST $PORDER DUP SIZE GET
RCLPOLYORD EVAL
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $NormalForm
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$NormalForm
«
 G P
«
IF G {} ‹ THEN
P G « PDIVORDER » QUICKSORT
PDIV NIP
ELSE P
END
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $ReduceAll
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$ReduceAll
«
0 {} {}  h G0 P0
«
WHILE ŽR {} ‹ REPEAT
ŽR HEAD 'h' STO
ŽR TAIL 'ŽR' STO
ŽG ŽP 1. «  p « IF ŽG p POSPOLY NOT THEN p END » » DOLISTX + h $NormalForm 'h' STO
IF h 0 SAME NOT THEN
ŽG 1. «  g « IF h LTERM g LTERM $MONODIV THEN g END » » DOLISTX 'G0' STO
ŽP 1. «  p « IF h LTERM p LTERM $MONODIV THEN p END » » DOLISTX 'P0' STO
ŽG 1. «  g « IF G0 g POSPOLY NOT THEN g END » » DOLISTX 'ŽG' STO
ŽP 1. «  p « IF P0 p POSPOLY NOT THEN p END » » DOLISTX 'ŽP' STO
G0 1. «  g0 « IF ŽR g0 POSPOLY NOT P0 g0 POSPOLY NOT AND THEN g0 END » » DOLISTX
P0 1. «  p0 « IF ŽR p0 POSPOLY NOT G0 p0 POSPOLY NOT AND THEN p0 END » » DOLISTX
+ 'ŽR' STO+
ŽB 1. «  b « IF G0 b HEAD POSPOLY G0 b TAIL POSPOLY OR NOT THEN b END » »
DOLISTX 'ŽB' STO
IF ŽP h POSPOLY NOT THEN ŽP h + 'ŽP' STO END
END
END
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $SelStrategy
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$SelStrategy
«
0 0 0 0  p1 p2 p1f1 p1f2 p2f1 p2f2
«
p1 {'p1f1' 'p1f2'} STO
p2 {'p2f1' 'p2f2'} STO
p1f1 LTERM p1f2 LTERM $MONOLCM $MONOLIST
p2f1 LTERM p2f2 LTERM $MONOLCM $MONOLIST
RCLPOLYORD EVAL
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $NewBasis
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$NewBasis
«
0 0 0 0 {} {}  p g h k H K
«
ŽP 1. «  p « IF ŽG p POSPOLY NOT THEN p END » » DOLISTX 'ŽG' STO+
IF ŽG SIZE 0 > THEN
1. ŽG SIZE
FOR g.I
'ŽG' g.I GET 'g' STO
1. ŽP SIZE
FOR p.I
'ŽP' p.I GET 'p' STO
IF g p POLYEQ NOT
ŽB g p 2. LIST POSPOLYPAIR NOT AND
THEN
g p 2. LIST 1. LIST 'ŽB' STO+
END
NEXT
NEXT
END
ŽB « $SelStrategy » QUICKSORT 'ŽB' STO
ŽG 'H' STO
{} 'K' STO
WHILE H {} ‹ REPEAT
H HEAD 'h' STO
H TAIL 'H' STO
ŽG 1. «  g « IF g h POLYEQ NOT THEN g END » » DOLISTX
h $NormalForm 'k' STO
IF K k POSPOLY NOT THEN K k + 'K' STO END
END
K 'ŽG' STO
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $Criterion1
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$Criterion1
«
0 0.  f1 f2 p c
«
IF ŽG SIZE 0. > THEN
1. ŽG SIZE
FOR p.I
'ŽG' p.I GET 'p' STO
IF f1 p POLYEQ NOT f2 p POLYEQ NOT AND
p LTERM f1 LTERM f2 LTERM $MONOLCM $MONODIV AND
ŽB f1 p 2. LIST POSPOLYPAIR NOT AND
ŽB p f2 2. LIST POSPOLYPAIR NOT AND
THEN
1. 'c' STO
END
NEXT
END
c
»
»
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@ $Criterion2
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
$Criterion2
«
 f1 f2
«
f1 LTERM f2 LTERM $MONOLCM f1 LMONO f2 LMONO * POLYEQ
»
»
END
HOME 256 ATTACH '$D' PGDIR '$D' STO $D CRLIB
HOME {$D $ROMID} RCL 1 TAG PURGE 1 STO {$D $ROMID} RCL ATTACH
HOME '$D' PGDIR
You can’t perform that action at this time.