XProfan

Título de la ventana "Prim & Co. Versión para XProfan-11.2 free"
CLS:AppendMenuBar 100,\
"  Auf XProfan-11.2a zurückgequält 2016-08 de P.Pájaro carpintero,Wien; OHNE JEGLICHE GEWÄHR!"

Proc IsPrim :Parámetros n&' Feststellen uno Primzahl por Faktorenzerlegung

    Declarar PFactor&[],prim&:PFactor&[]=PrimFac(n&):prim&=SizeOf(PFactor&[]):Volver (prim&=1)

ENDPROC

Proc PrimFac :Parámetros n&' Primfaktor-Zerlegung. Espectáculos 2·2·3·..

    'Imprimir "PrimFac(123456)=";:WhileLoop 0,SizeOf(PFactor[])-1:Imprimir if(&loop=0,"","·");PFactor[&loop];:EndWhile
    Declarar PFac&[],cnt&,diff&,t&:cnt&=0:diff&=2:t&=5
    :Sinestar encargado n& mod 2:PFac&[cnt&]=2:inc cnt&:n&=n& \2:EndWhile
    :Sinestar encargado n& mod 3:PFac&[cnt&]=3:inc cnt&:n&=n& \3:EndWhile
    :Mientras que sqr(t&)<=n&:Sinestar encargado n& mod t&:PFac&[cnt&]=t&:inc cnt&:n&=n& \t&:EndWhile
    t&=t&+diff&:diff&=6-diff&:EndWhile:Case n&>1:PFac&[cnt&]=n&:Volver PFac&[]

ENDPROC

Proc findInX :Parámetros fac&:Var erg!=-1:Case SizeOf(x&[])<1:Volver erg!

    :WhileLoop 0,SizeOf(x&[])-1:If x&[&bucle]=fac&:erg!=&bucle:Romper:EndIf:EndWhile:Volver erg!

ENDPROC

Proc addInX :Parámetros fac&,fcnt&:Declarar n&:n&=findInX(fac&)

    If n&=-1:Inc cnt&:x&[cnt&]=fac&:xc&[cnt&]=fcnt&:Más :Case xc&[n&]<fcnt&:xc&[n&]=fcnt&:EndIf

    ENDPROC

    Proc sum:var erg!=0

        If SizeOf(x&[])>0:erg!=x&[0]^xc&[0]

            :WhileLoop 1,SizeOf(x&[])-1:erg!=erg!*x&[&bucle]^xc&[&bucle]:EndWhile
            EndIf:Volver erg!

        ENDPROC

        Proc pfc :Parámetros n&:Declarar fac&,fcnt&,diff&,t&:diff&=2:t&=5:fac&=2:fcnt&=0

            :Sinestar encargado n& mod 2:inc fcnt&:n&=n& \2:EndWhile:Case fcnt&>0:addInX(2,fcnt&)
            fac&=3:fcnt&=0:Sinestar encargado n& mod 3:inc fcnt&:n&=n& \3:EndWhile:Case fcnt&>0:addInX(3,fcnt&)

            Mientras que sqr(t&)<=n&:fcnt&=0:Sinestar encargado n& mod t&:inc fcnt&:n&=n& \t&:EndWhile

                Case fcnt&>0:addInX(t&,fcnt&) : t&=t&+diff&:diff&=6-diff&
                EndWhile:Case n&>1:addInX(n&,1)

            ENDPROC

            Proc kgV'Kleinstes gemeinsames Vielfaches. Erlaubt 2 a 9 Parámetro:

                '  Imprimir "kgV(12,8)=";format$("%d",kgV(12,8))
                '  Imprimir "kgV(62,36)=";format$("%d",kgV(62,36))
                Declarar erg!,cnt&,x&[],xc&[]:cnt&=-1

                Select %PCount

                    CaseOf 9:Parámetros a9&,b9&,c9&,d9&,e9&,f9&,g9&,h9&,i9&

                    pfc a9&:pfc b9&:pfc c9&:pfc d9&:pfc e9&:pfc f9&:pfc g9&:pfc h9&:pfc i9&:Volver sum()

                    CaseOf 8:Parámetros a8&,b8&,c8&,d8&,e8&,f8&,g8&,h8&

                    pfc a8&:pfc b8&:pfc c8&:pfc d8&:pfc e8&:pfc f8&:pfc g8&:pfc h8&:Volver sum()

                    CaseOf 7:Parámetros a7&,b7&,c7&,d7&,e7&,f7&,g7&

                    pfc a7&: pfc b7&: pfc c7&: pfc d7&: pfc e7&: pfc f7&: pfc g7&:Volver sum()

                    CaseOf 6:Parámetros a6&,b6&,c6&,d6&,e6&,f6&

                    pfc a6&: pfc b6&: pfc c6&: pfc d6&: pfc e6&: pfc f6&:Volver sum()

                    CaseOf 5:Parámetros a5&,b5&,c5&,d5&,e5&:pfc a5&: pfc b5&: pfc c5&: pfc d5&: pfc e5&:Volver sum()

                    CaseOf 4:Parámetros a4&,b4&,c4&,d4&:pfc a4& : pfc b4& : pfc c4& : pfc d4&:Volver sum()

                    CaseOf 3:Parámetros a3&,b3&,c3&:pfc a3& : pfc b3& : pfc c3&:Volver sum()

                    CaseOf 2:Parámetros a2&,b2&:pfc a2&: pfc b2&:Volver sum()

                    EndSelect:Volver 0.0

                ENDPROC

                Proc ggT2 :Parámetros a&,b&' Größter gemeinsamer Teiler, 2 Parámetro

                    Declarar t& :if b&>a&:t&=a&:a&=b&:b&=t&:endif:Casenot b&:Volver a& : Volver ggT2(b&,a& mod b&)

                ENDPROC

                Proc ggT' Größter gemeinsamer Teiler. 1 a 9 Parámetro

                    Select %PCount

                        CaseOf 9:Parámetros a9&,b9&,c9&,d9&,e9&,f9&,g9&,h9&,i9&

                        Volver ggT2(ggT2(ggT2(ggT2(ggT2(ggT2(ggT2(ggT2(a9&,b9&),c9&),d9&),e9&),f9&),g9&),h9&),i9&)

                        CaseOf 8:Parámetros a8&,b8&,c8&,d8&,e8&,f8&,g8&,h8&

                        Volver ggT2(ggT2(ggT2(ggT2(ggT2(ggT2(ggT2(a8&,b8&),c8&),d8&),e8&),f8&),g8&),h8&)

                        CaseOf 7:Parámetros a7&,b7&,c7&,d7&,e7&,f7&,g7&

                        Volver ggT2(ggT2(ggT2(ggT2(ggT2(ggT2(a7&,b7&),c7&),d7&),e7&),f7&),g7&)

                        CaseOf 6:Parámetros a6&,b6&,c6&,d6&,e6&,f6&

                        Volver ggT2(ggT2(ggT2(ggT2(ggT2(a6&,b6&),c6&),d6&),e6&),f6&)

                        CaseOf 5:Parámetros a5&,b5&,c5&,d5&,e5&

                        Volver ggT2(ggT2(ggT2(ggT2(a5&,b5&),c5&),d5&),e5&)

                        CaseOf 4:Parámetros a4&,b4&,c4&,d4&:Volver ggT2(ggT2(ggT2(a4&,b4&),c4&),d4&)

                        CaseOf 3:Parámetros a3&,b3&,c3&:Volver ggT2(ggT2(a3&,b3&),c3&)

                        CaseOf 2:Parámetros a2&,b2&:Volver ggT2(a2&,b2&)

                        CaseOf 1:Parámetros a1&:Volver a1&

                        EndSelect:Volver 0

                    ENDPROC

                    Proc kgV_aus_ggT :var erg!=0

                        '' Statt Abstreich-Método kann kgV auch mittels "Summe por ggT" ermittelt voluntad. Bsp.:
                        '  Imprimir "kgV_aus_ggT(53667,459486)=";format$("%d",kgV_aus_ggT(53667,459486))
                        '  Imprimir "kgV_aus_ggT(62,36)=";format$("%d",kgV_aus_ggT(62,36))

                        Select %PCount

                            CaseOf 9:Parámetros a9&,b9&,c9&,d9&,e9&,f9&,g9&,h9&,i9&

                            erg!=a9&*b9&*c9&*d9&*e9&*f9&*g9&*h9&*i9& / ggT(a9&,b9&,c9&,d9&,e9&,f9&,g9&,h9&,i9&)

                            CaseOf 8:Parámetros a8&,b8&,c8&,d8&,e8&,f8&,g8&,h8&

                            erg!=a8&*b8&*c8&*d8&*e8&*f8&*g8&*h8& / ggT(a8&,b8&,c8&,d8&,e8&,f8&,g8&,h8&)

                            CaseOf 7:Parámetros a7&,b7&,c7&,d7&,e7&,f7&,g7&

                            erg!=a7&*b7&*c7&*d7&*e7&*f7&*g7& / ggT(a7&,b7&,c7&,d7&,e7&,f7&,g7&)

                            CaseOf 6:Parámetros a6&,b6&,c6&,d6&,e6&,f6&

                            erg!=a6&*b6&*c6&*d6&*e6&*f6& / ggT(a6&,b6&,c6&,d6&,e6&,f6&)

                            CaseOf 5:Parámetros a5&,b5&,c5&,d5&,e5&:erg!=a5&*b5&*c5&*d5&*e5& / ggT(a5&,b5&,c5&,d5&,e5&)

                            CaseOf 4:Parámetros a4&,b4&,c4&,d4&:erg!=a4&*b4&*c4&*d4& / ggT(a4&,b4&,c4&,d4&)

                            CaseOf 3:Parámetros a3&,b3&,c3&:erg!=a3&*b3&*c3& / ggT(a3&,b3&,c3&)

                            CaseOf 2:Parámetros a2&,b2&:erg!=a2&*b2& / ggT(a2&,b2&)

                            CaseOf 1:Parámetros a1&:erg!=a1&

                            EndSelect:Volver erg!

                        ENDPROC

                        ' Hauptprogramm:
                        Imprimir "\n\n T E S T :"
                        declarar x&,y&,i&,j&,e&,path$,limit&,limit$
                        declarar PFactor&[]
                        imprimir "\n\n kgV(53667,459486)=";format$("%d",kgV(53667,459486))
                        imprimir " kgV_aus_ggt(53667,459486)=";format$("%d",kgV_aus_ggT(53667,459486))
                        imprimir " ----------------------------------------------------------------------"
                        x&=62 : y&=36 :imprimir "\n ggT2(";x&;",";y&;")=",ggT(x&,y&)
                        x&=1023 : y&=99 :imprimir " ggT2(";x&;",";y&;")=",ggT(x&,y&)
                        x&=1071 : y&=1029 :imprimir " ggT2(";x&;",";y&;")=",ggT(x&,y&)
                        imprimir " -------"
                        imprimir "\n ggT(1023,99,1071,1029)=",ggT(1023,99,1071,1029)
                        imprimir " ggT(15400,7875,3850)=",ggT(15400,7875,3850)
                        font 2:imprimir "\n ----------------------------------------------------------"
                        66EA1F72BEC94EAEA8A150F6BC904FA2:
                        Imprimir "\n Auf PRIM a testende Zahl: ";:input limit$

                        if val(limit$)>(2^31-1):imprimir "Zu groß!":sound 800,100:goto "66EA1F72BEC94EAEA8A150F6BC904FA2":endif

                            limit&=val(limit$)
                            locate %csrlin-1,45:imprimir if(isPrim(limit&)," <<< es PRIM!"," <<< es no prim.")
                            imprimir "\n ---------------------- [Start] ----------------------------"
                            Imprimir "\n Zerlegungen voluntad en Expediente el Desktop geschrieben."
                            Imprimir "\n Bis a welcher Obergrenze debería el Faktoren ermittelt voluntad? "
                            imprimir "\n Limit = ";:input limit&:imprimir
                            path$=getenv$("USERPROFILE")+"\DESKTOP\Primfaktoren.txt":e&=%IOResult
                            Asignar #1,path$:e&=%IOResult
                            Rewrite #1:e&=%IOResult

                            if e&:Imprimir "Problem beim Carta el Expediente "+path$:waitinput:sound 1000,200:End:Endif

                                Imprimir  "\n Daten voluntad soeben geschrieben después de: ";path$
                                caso limit&<=3000:Imprimir  "\n Primfaktoren (2.."+str$(limit&)+")"
                                Imprimir #1,"Datei el Primfaktoren de 2 a "+str$(limit&)
                                'WhileLoop 20000,limit&

                                WhileLoop 2,limit&

                                    caso limit&<=3000:Imprimir  "\n Faktoren(";&bucle;"): ";
                                    Imprimir #1,"\n(";&bucle;") ";
                                    PFactor&[]=PrimFac(&bucle)
                                    i&=0 : j&=SizeOf(PFactor&[])

                                    Mientras que i&<j&

                                        caso limit&<=3000:Imprimir  "" + if(i&=0,"","·"); PFactor&[i&];
                                        Imprimir #1,"" + if(i&=0,"","·"); PFactor&[i&];
                                        Inc i&

                                    EndWhile

                                    Claro PFactor&[]
                                    caso limit&<=3000:Imprimir  ""+if(IsPrim(&bucle)," PRIM","");
                                    Imprimir #1,""+if(IsPrim(&bucle)," PRIM","");

                                EndWhile

                                Imprimir #1,"\nEOF":e&=%IOResult
                                Cerrar #1:e&=%IOResult
                                Imprimir  "\n Daten fueron geschrieben después de: ";path$:sound 2000,90
                                Imprimir "\n Ende":WaitInput:End