HP Forums
(49G) Lagrange Four Squares Representation of an Integer - Printable Version

+- 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
;