XProfan

Título de la ventana "Erweiterter Euklidischer Algorithmus, non-rekursiv programmiert"
' (CL) Copyleft 2013-05 by P.Pájaro carpintero, Wien
' Q: https://de.wikipedia.org/wiki/Erweiterter_euklidischer_Algorithmus
' Keine Gewähr! Use solely on your own risk!
'{ Initialisierung, Ein- y Edición-Hauptschleife
Ventana %maxx,%maxy
font 2:randomize
set("decimals",1)
declarar tab%,px%,verbose%
Declarar a!,b!,ggt!,s!,t!
tab%=14' Spaltentabulator
verbose%=0' Lösungsweg Mostrar
a!=99:b!=78' Test caso
cls rnd(8^8):imprimir

mientras que 1

    Imprimir " A= ";:input a!
    Imprimir " B= ";:input b!
    ggt!=Extended_Euklid(a!,b!;s!,t!)
    imprimir "\n Ergebnis    GGT           S           T               S*A+T*B         "
    imprimir "";tab(tab%);ggt!,tab(tab%*2);s!,tab(tab%*3);t!,tab(tab%*4);s!*a!+t!*b!;"\n\n"

    if %csrlin>27:waitinput :px%=getpixel(1,1):cls px%:endif

    endwhile

    '}
    '{Math Pack I (0.1_beta): Number Theory - Base Functions
    ' Intf(a!), Frac(a!), Floor(a!), Ceil(a!), Sgn(a!), IsNeg(a!),
    ' Modf(a!,b!), Remn(a!,b!), SymModf(a!,b!), ggT(a!,b!), kgV(a!,b!)
    ' Printf(a!),Printfln(a!)

    proc sgn :parámetros x!

        ' Signum-Función: -1,0,+1
        volver (x!>0)-(x!<0)

    ENDPROC

    proc floor :parámetros x!

        ' Gaussklammer-Función
        caso abs(x!)<(10^-35):volver 0
        caso x!>0:volver intf(x!)
        volver (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))

    ENDPROC

    proc ceil :parámetros x!

        ' Ceiling-Función
        volver -1*floor(-1*x!)

    ENDPROC

    proc modf :parámetros x!,y!

        ' Q: https://de.wikipedia.org/wiki/Modulo
        caso abs(x!)<10^-35:volver 0
        caso abs(y!)<10^-35:volver x!
        volver sgn(y!)*abs(x!-y!*floor(x!/y!))

    ENDPROC

    proc remn :parámetros x!,y!

        ' Q: https://de.wikipedia.org/wiki/Modulo , como en ADA
        caso abs(x!)<(10^-35):volver 0
        caso abs(y!)<(10^-35):volver x!
        volver sgn(x!)*abs(x!-y!*floor(x!/y!))

    ENDPROC

    proc IsNeg :parámetros x!

        volver byte(Addr(x!),7)&%10000000>>7

    ENDPROC

    proc frac :parámetros x!

        var s!=sgn(x!)
        x!=abs(x!)
        x!=x!-round(x!,0)
        caso x!<0:x!=1+x!
        volver s!*x!

    ENDPROC

    proc intf :parámetros x!

        var s!=sgn(x!)
        x!=abs(x!)
        x!=x!-frac(x!)
        volver s!*x!

    ENDPROC

    proc symmodf :parámetros x!,y!

        declarar v!
        caso abs(x!)<10^-322:volver 0
        caso abs(y!)<10^-304:volver x!
        v!=x!-y!*floor(x!/y!)
        caso (2*v!)>y!:v!=v!-y!'symmetric modf()
        volver v!

    ENDPROC

    proc ggT :parámetros a!,b!

        declarar h!

        whilenot nearly(b!,0,11)

            h!=a!-b!*floor(a!/b!)'orig: int() ???
            a!=b!
            b!=h!

        endwhile

        volver a!

    ENDPROC

    proc kgV :parámetros a!,b!

        volver a!*b!/ggt(a!,b!)

    ENDPROC

    proc printf :parámetros x!

        imprimir format$("+#.#################E+000;"+\
        "-#.#################E+000;" + " 0.0###############0e0000" ,c!);

    ENDPROC

    proc printfln :parámetros x!

        prt(x!):imprimir

    ENDPROC

    '}
    '{ Math Pack II (0.1_alpha): Number Theory - Higher Functions
    ' ggt!=Extended_Euklid(a!,b!)' +> s!,t!

    proc Extended_Euklid :parámetros a!,b!

        'liefert ggT! sowie a el extern definierten Variables s!,t!
        declarar a0!,b0!,q0!,r0!,u0!,s0!,v0!,t0!
        declarar a1!,b1!,q1!,r1!,u1!,s1!,v1!,t1!
        init:
        a0!=0:b0!=a!:q0!=0:r0!=b!
        u0!=0:s0!=1:v0!=1:t0!=0'Hilfsvariablen
        casenot verbose%:goto "rept"
        imprimir
        imprimir "A",tab(tab%);"B",tab(tab%*2);"Q",tab(tab%*3);"R",tab(tab%*4);
        imprimir "U",tab(tab%*5);"S",tab(tab%*6);"V",tab(tab%*7);"T"
        imprimir
        imprimir a0!,tab(tab%);b0!,tab(tab%*2);q0!,tab(tab%*3);r0!,tab(tab%*4);
        imprimir u0!,tab(tab%*5);s0!,tab(tab%*6);v0!,tab(tab%*7);t0!
        rept:
        a1!=b0!:u1!=s0!:v1!=t0!:b1!=r0!
        s1!=u0!-q0!*s0!:t1!=v0!-q0!*t0!

        if nearly(b1!,0,11)

            s!=s0!:t!=t0!:volver a1!

        endif

        q1!=int(a1!/b1!)
        r1!=a1!-b1!*q1!
        casenot verbose%:goto "zeilenschritt"
        imprimir a1!,tab(tab%);b1!,tab(tab%*2);q1!,tab(tab%*3);r1!,tab(tab%*4);
        imprimir u1!,tab(tab%*5);s1!,tab(tab%*6);v1!,tab(tab%*7);t1!
        zeilenschritt:
        a0!=a1!:b0!=b1!:q0!=q1!:r0!=r1!
        u0!=u1!:s0!=s1!:v0!=v1!:t0!=t1!
        goto "rept"

    ENDPROC

    '}