+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Software Libraries (/forum-10.html)
+--- Forum: General Software Library (/forum-13.html)
+--- Thread: (49G) Lagrange Four Squares Representation of an Integer (/thread-4237.html)
(49G) Lagrange Four Squares Representation of an Integer - Gerald H - 06-26-2015 07:10 PM
Lagrange showed that four squares are sufficient to represent any integer & this programme celebrates his proof.
For input to LAGRA of
98765432167
the programme returns
{ 253245 180438 45547 33 }
or
{ 208927 191294 135379 13931 }
or
{ 261213 170826 27781 24081 }
or one of the other in total 790123457344 four square decompositions of the same number.
The programme LAGRA has one sub-programme, x00E, see below LAGRA
Code:
LAGRA
::
CK1&Dispatch
# FF
::
::
FPTR2 ^MZSQFF
ZEROSWAP
#2/
ZERO_DO
DUP
#3+
DUP#1+
ROLLSWAP
ROLL
COERCE
BINT2
#/
SWAP
#0=?SKIP
::
OVERDUP
Z4_
FPTR2 ^ZMod
Z3_
::
EQUALNOTcase
::
FPTR2 ^SUMSQRext
SWAPDROP
INCOMPDROP
Z0_
Z0_
;
DUP
Z0_
DUPDUP
BINT4
{}N
Z1_
ROT
::
DUP
FPTR2 ^Z>R
%RAN
%*
%IP
%2
%MAX
FPTR2 ^R>Z
BEGIN
Z1_
FPTR2 ^RADDext
Z-1_
OVER
FPTR2 ^ZSQ_
FPTR2 ^QSub
DUP
4PICK
::
FPTR2 ^DupQIsZero?
casedrop
::
FPTR2 ^ZAbs
FPTR2 ^DupZIsOne?
NOTcasedrop
Z0_
;
FPTR2 ^DupZIsEven?
ROT
FPTR2 ^DupZIsEven?
ROTAND
case2drop
Z0_
TRUE
SWAPROT
'
::
FPTR2 ^ZTrialDiv2
BINT1
#AND
#0=?SEMI
OVER
Z8_
FPTR2 ^QMod
FPTR2 ^ZAbs
Z3_
EQUAL
4ROLL
XOR
3UNROLL
;
DUP1LAMBIND
EVAL
FPTR2 ^DupZIsNeg?
IT
::
FPTR2 ^ZAbs
OVER
FPTR2 ^ZIsNeg?
4ROLL
XOR
3UNROLL
;
DUPUNROT
FPTR2 ^IDIV2
SWAPDROP
BEGIN
1GETLAM
EVAL
SWAP
BINT4
FPTR2 ^ZBit?
SWAPONE
FPTR2 ^ZBit?
ROTSWAP
EQUAL
::
?SEMI
OVER
BINT4
FPTR2 ^ZBit?
SWAPONE
FPTR2 ^ZBit?
SWAPDROP
XOR
4ROLL
XOR
3UNROLL
;
OVER
FPTR2 ^ZMod
FPTR2 ^DupQIsZero?
UNTIL
ABND
DROP
FPTR2 ^ZIsOne?
NOTcasedrop
Z0_
case
Z1_
Z-1_
;
FPTR2 ^ZIsOne?
NOT_WHILE
DROP
REPEAT
3PICK
Z1_
FPTR2 ^QAdd
Z4_
FPTR2 ^ZQUOText
4ROLL
DUP4UNROLL
FPTR2 ^ModPow
FPTR2 ^DupZIsNeg?
case
FPTR2 ^QAdd
SWAPDROP
;
Z0_
BINT4
{}N
Z0_
BINT4
NDUPN
{}N
3UNROLL
BEGIN
3PICKOVER
EQUAL
NOT_WHILE
::
DUPUNROT
DUP
INCOMPDROP
Z0_
BINT4
ZERO_DO
SWAPDUP
FPTR2 ^QMul
FPTR2 ^QAdd
LOOP
DUP4UNROLL
Z2_
FPTR2 ^ZQUOText
FPTR2 ^2LAMBIND
DUPUNROT
2GETLAM
INNERCOMP
ONE_DO
ROT
FPTR2 ^RNEGext
LOOP
BINT4
{}N
SWAP
INCOMPDROP
ID x00E
5ROLL
BINT10
BINT6
DO
DUPUNROT
FPTR2 ^IDIV2
INDEX@
UNROLL
5UNROLL
LOOP
9UNROLL_
BINT4
{}N
5UNROLL
BINT4
{}N
ROT
FPTR2 ^DupZIsEven?
SWAPDROP
ITE
::
DUP
1GETLAM
BINT4
NDUPN
{}N
EQUAL
;
FALSE
ITE
::
3DROP
Z0_
BINT4
NDUPN
;
::
2GETLAM
3UNROLL
INNERCOMP
ZERO_DO
1GETLAM
Z>
ITE
Z1_
Z0_
4UNROLL
LOOP
5ROLL
INCOMPDROP
BINT4
ZERO_DO
5ROLL
FPTR2 ^QAdd
4UNROLL
LOOP
ID x00E
5ROLL
INCOMPDROP
BINT4
ZERO_DO
5ROLL
FPTR2 ^QSub
4UNROLL
LOOP
BINT4
;
{}N
ABND
;
REPEAT
DROPSWAPDROP
INNERCOMP
ZERO_DO
FPTR2 ^ZAbs
4ROLL
LOOP
;
BINT4
{}N
4UNROLLROT
#1+
3UNROLL
;
DUP#0=ITE
2DROP
::
FPTR2 ^PPow#
Z0_
DUPDUP
BINT4
{}N
SWP1+
;
LOOP
DUP#1=
caseDROP
SWAP
INCOMPDROP
5ROLL
ONE_DO
ID x00E
LOOP
BINT4
ZERO_DO
FPTR2 ^ZABS
4ROLL
LOOP
BINT4
{}N
;
'
Z<
FPTR2 ^SortList
;
;
x00E
::
5ROLL
INCOMPDROP
BINT2
ZERO_DO
8PICK
5PICK
FPTR2 ^QMul
LOOP
FPTR2 ^QSub
7PICK
4PICK
FPTR2 ^QMul
FPTR2 ^QSub
6PICK
3PICK
FPTR2 ^QMul
FPTR2 ^QSub
9UNROLL_
8PICK
4PICK
FPTR2 ^QMul
8PICK
6PICK
FPTR2 ^QMul
FPTR2 ^QAdd
7PICK
3PICK
FPTR2 ^QMul
FPTR2 ^QAdd
6PICK
4PICK
FPTR2 ^QMul
FPTR2 ^QSub
9UNROLL_
BINT2
ZERO_DO
8PICK
3PICK
FPTR2 ^QMul
LOOP
FPTR2 ^QSub
7PICK
6PICK
FPTR2 ^QMul
FPTR2 ^QAdd
6PICK
5PICK
FPTR2 ^QMul
FPTR2 ^QAdd
9UNROLL_
8ROLL
FPTR2 ^QMul
SWAP
7ROLL
FPTR2 ^QMul
FPTR2 ^QAdd
SWAP
5ROLL
FPTR2 ^QMul
FPTR2 ^QSub
3UNROLL
FPTR2 ^QMul
FPTR2 ^QAdd
;