XProfan

WindowTitle upper$("Diophantische (ganzzahlig zu lösende) Gleichungen")
' Q: https://jean-pierre.moreau.pagesperso-orange.fr/Fortran/diophan_f90.txt
' (D) Demoware 2015-07 von F90 nach XProfan-11 by P.Specht, Wien
' Demo only. Original Copyright applies fully. Ohne jegliche Gewähr!
WindowStyle 24:font 2:randomize:set("Decimals",10)
CLS : var TRUE&=1:var FALSE&=0
'**********************************************
'* Solving a diophantian equation ax+by = c   *
'*      (a,b,c,x,y are integer numbers)       *
'* ------------------------------------------ *
'* Ref.: "Mathématiques en Turbo-Pascal       *
'*        By M. Ducamp and A. Reverchon (2),  *
'*        Eyrolles, Paris, 1988"              *
'* ------------------------------------------ *
'* Sample run:                                *
'*                                            *
'* SOLVING IN Z EQUATION AX + BY = C          *
'*                                            *
'*    A = 3                                   *
'*    B = -2                                  *
'*    C = 7                                   *
'*                                            *
'* Solutions are:                             *
'*                                            *
'*   X =    1 +     2*K                       *
'*   Y =   -2 +     3*K                       *
'*                                            *
'*                F90 Version By J-P Moreau.  *
'*                    (www.jpmoreau.fr)       *
'**********************************************
'*    XProfan-11 Version By P.Specht, Vienna  *
'**********************************************
Declare a!,b!,c!,p!,q!,x0!,y0!,iresult!,Diophantian!
Dio_Main:
Clear  a!,b!,c!,p!,q!,x0!,y0!,iresult!,Diophantian!
print "\n---------------------------------------------------------"
print " LÖSE DIE ALL-GANZZAHLIGE GLEICHUNG:  a * X + b * Y = c "
print "---------------------------------------------------------"
Print " a = ";:input a!
Print " b = ";:input b!
Print " c = ";:input c!
print "---------------------------------------------------------"
iresult! = Diophantian(a!,b!,c!)

if iresult!>0

    print " Lösungen:\n\n   X=   Y=  "
    print    tab(4-(x0!<0));format$("%g",x0!)," + ";format$("%g",abs(q!));" * K"

    if (p!*q!)>0

        print tab(4-(Y0!<0));format$("%g",y0!)," - ";format$("%g",abs(p!));" * K"

    else

        print tab(4-(Y0!<0));format$("%g",y0!)," + ";format$("%g",abs(p!));" * K"

    endif

    print "\n mit K = {...,-3,-2,-1,0,+1,+2,+3,...} "

else

    font 0:beep:print "\n Keine Lösungen gefunden!"

endif

font 2:print "---------------------------------------------------------\n"
Waitinput 60000
case %csrlin>50:cls
GOTO "Dio_Main"

proc Diophantian :parameters a!,b!,c!

    '***********************************************************
    '* Solving equation ax+by=c, a,b,c,x,y are integer numbers *
    '* ------------------------------------------------------- *
    '* INPUT:   a,b,c       coefficients of equation           *
    '* OUTPUT:  solutions are x0+kp and y0-kq, with k=0,1,2... *
    '*          or k=-1,-2,-3...                               *
    '* The function returns TRUE if solutions exist (that is,  *
    '* if the GCD of a,b is also a divisor of c).              *
    '***********************************************************
    'Integer Function Diophantian(a,b,c,x0,y0,p,q)
    Var TRUE!=1 : Var FALSE!=0
    declare aa!,bb!,pg!,x1!,x2!,y1!,y2!
    declare ifound!,GCD!,Diophantian!
    Diophantian!=FALSE!
    Case (a!=0) Or (b!=0):goto "Dio_return"
    aa!=a!:bb!=b!'Send copies of a and b to function GCD!
    pg! = GCD(aa!,bb!)'(XProfan kapselt eigentlich ohnehin selbst)
    a!=a!/pg!:b!=b!/pg!:c!=c!/pg!
    Case c!<>INT(c!):goto "Dio_return"' pg must be also a divisor of c
    x1!=0: y2!=0 : ifound!=FALSE!
    Dio_10:
    y1!=(c!-a!*x1!)/b!

    if y1!=INT(y1!)

        x0!=x1!:y0!=y1!
        ifound!=TRUE!

    else

        x1!=-x1!:case x1!>=0:x1!=x1!+1
        x2!=(c!-b!*y2!)/a!

        if x2!=INT(x2!)

            x0!=x2!: y0!=y2!: ifound!=TRUE!

        else

            y2!=-y2!:case y2!>=0:y2!=y2!+1

        endif

    endif

    case ifound!=FALSE!:goto "Dio_10"
    p!=a! : q!=b!
    Diophantian!=TRUE!
    Dio_return:
    return Diophantian!

Endproc

Proc GCD :parameters a!,b!

    ' Greatest common divisor of two integer numbers
    declare r!,temp!,GCD!
    a!=int(abs(a!)):b!=int(abs(b!))

    if (a!>10^10) or (b!>10^10):GCD!=1:goto "gcd_exit":endif

        if (a!=0) OR (b!=0):GCD!=1:goto "gcd_exit":endif

            if a!<b!:temp!=a!:a!=b!:b!=temp!:endif

                GCD_1010:
                r!=a!-b!*int(a!/b!):a!=b!:b!=r!
                case (abs(r!)>10^-10):goto "GCD_1010"
                GCD!=a!
                GCD_exit:
                return gcd!

            endproc