• Print

Author Topic: raising integers to an integer power (arbitrary precision)  (Read 85 times)

codeguy

  • Hero Member
  • *****
  • Posts: 4044
  • what the h3ll did i name that code?
    • stuff at dkm
raising integers to an integer power (arbitrary precision)
« on: April 13, 2018, 01:54:52 am »
Code: [Select]
'* CodeGuy SuperPower
REDIM POWERS(0) AS LONG
s& = 0
DO
    s& = s& + 1
    s! = TIMER(.001)
    PowerOF 2, s&, POWERS(), NthPower&
    f! = TIMER(.001)
    FOR C& = NthPower& TO 0 STEP -1
        A$ = LTRIM$(STR$(POWERS(C&)))
        WHILE LEN(A$) < 4
            A$ = "0" + A$
        WEND
        PRINT " " + A$;
        IF (NthPower& - (C& + 1)) MOD 16 = 0 THEN
            '_DELAY .125
        END IF
    NEXT
    PRINT s&; f! - s!
    s& = s& * 2
LOOP

SUB PowerOF (XBASE&, n&, POW() AS LONG, EXPONENT&)
    REDIM POW(0 TO 16) AS LONG
    POW(0) = 1
    t& = 0
    CARRY& = 0
    DIM MaxLongN AS _UNSIGNED LONG
    MaxLongN = 2 ^ 32 - 1
    IF XBASE& < SQR(MaxLongN / 100) THEN
        REDIM xb(1 TO 32) AS LONG
        xb(1) = XBASE&
        Mb10& = MaxLongN MOD 10000
        MaxLongN = (MaxLongN - Mb10&)
        c& = 2
        DO
            xb(c&) = xb(c& - 1) * XBASE&
            c& = c& + 1
        LOOP UNTIL xb(c& - 1) >= MaxLongN / 10000
        DO
            IF c& > 1 THEN
                IF xb(c&) THEN
                    EXIT DO
                ELSE
                    c& = c& - 1
                END IF
            ELSE
                EXIT DO
            END IF
        LOOP
        REDIM _PRESERVE xb(1 TO c&)
        ax& = UBOUND(xb)
        WHILE t& < n&
            WHILE t& < xb(ax&) AND ax& > 1
                ax& = ax& - 1
            WEND
            FOR c& = 0 TO UBOUND(POW)
                POW(c&) = POW(c&) * xb(ax&) + CARRY&
                IF POW(c&) >= 10000 THEN
                    p& = POW(c&) MOD 10000
                    CARRY& = (POW(c&) - p&) / 10000
                    POW(c&) = p&
                ELSE
                    CARRY& = 0
                END IF
            NEXT
            t& = t& + ax&
            IF CARRY& > 0 THEN
                DO
                    REDIM _PRESERVE POW(0 TO UBOUND(pow) + 1) AS LONG
                    POW(UBOUND(pow)) = CARRY&
                    p& = POW(c&) MOD 10000
                    CARRY& = (POW(c&) - p&) / 10000
                    POW(c&) = p&
                LOOP WHILE CARRY& <> 0
            END IF
        WEND
    ELSE
        WHILE t& < n&
            FOR c& = 0 TO UBOUND(POW)
                POW(c&) = POW(c&) * XBASE& + CARRY&
                IF POW(c&) >= 10000 THEN
                    p& = POW(c&) MOD 10000
                    CARRY& = (POW(c&) - p&) / 10000
                    POW(c&) = p&
                ELSE
                    CARRY& = 0
                END IF
            NEXT
            t& = t& + 1
            IF CARRY& > 0 THEN
                DO
                    REDIM _PRESERVE POW(0 TO UBOUND(pow) + 1) AS LONG
                    POW(UBOUND(pow)) = CARRY&
                    p& = POW(c&) MOD 10000
                    CARRY& = (POW(c&) - p&) / 10000
                    POW(c&) = p&
                LOOP WHILE CARRY& <> 0
            END IF
        WEND
    END IF
    EXPONENT& = UBOUND(POW)
    DO
        IF EXPONENT& > 0 THEN
            IF POW(EXPONENT&) = 0 THEN
                EXPONENT& = EXPONENT& - 1
            ELSE
                EXIT DO
            END IF
        ELSE
            EXIT DO
        END IF
    LOOP
END FUNCTION
« Last Edit: April 13, 2018, 02:20:00 am by codeguy »
http://denteddisk.forums-free.com/make-an-appointment-with-the-resident-code-guru-f34.html

BSpinoza

  • Newbie
  • *
  • Posts: 47
Re: raising integers to an integer power (arbitrary precision)
« Reply #1 on: April 13, 2018, 11:36:01 pm »
Perhaps I can implement this in the calculations for the Ackermann function (http://www.qb64.net/forum/index.php?topic=14825.0) ... ;D

Give me time!
„Alles Exzellente ist ebenso mühselig wie selten!“.
"All things excellent are as difficult as they are rare." Baruch Spinoza
BALENO, the ultimative RPN calculator:
https://drive.google.com/file/d/1o5AwmfwvYvavWCDdQq7pGYfQXG4T8PHZ/view?usp=sharing

  • Print