XProfan

Titre de la fenêtre "Prim & Co. Version pour XProfan-11.2 free"
CLS:AppendMenuBar 100,\
"  sur XProfan-11.2a zurückgequält 2016-08 de P.Specht,Wien; OHNE JEGLICHE GEWÄHR!"

Proc IsPrim :Paramètres n&' Feststellen einer Primzahl par Faktorenzerlegung

    Déclarer PFactor&[],prim&:PFactor&[]=PrimFac(n&):prim&=SizeOf(PFactor&[]):Retour (prim&=1)

ENDPROC

Proc PrimFac :Paramètres n&' Primfaktor-décomposition. Zeigt 2·2·3·..

    'Imprimer "PrimFac(123456)=";:WhileLoop 0,SizeOf(PFactor[])-1:Imprimer si(&loop=0,»,"·");PFactor[&loop];:Endwhile
    Déclarer PFac&[],cnt&,diff&,t&:cnt&=0:diff&=2:t&=5
    :Whilenot n& mod 2:PFac&[cnt&]=2:inc cnt&:n&=n& \2:Endwhile
    :Whilenot n& mod 3:PFac&[cnt&]=3:inc cnt&:n&=n& \3:Endwhile
    :Tandis que sqr(t&)<=n&:Whilenot n& mod t&:PFac&[cnt&]=t&:inc cnt&:n&=n& \t&:Endwhile
    t&=t&+diff&:diff&=6-diff&:Endwhile:Cas n&>1:PFac&[cnt&]=n&:Retour PFac&[]

ENDPROC

Proc findInX :Paramètres fac&:Var erg!=-1:Cas SizeOf(x&[])<1:Retour erg!

    :WhileLoop 0,SizeOf(x&[])-1:Si x&[&loop]=fac&:erg!=&loop:Pause:EndIf:Endwhile:Retour erg!

ENDPROC

Proc addInX :Paramètres fac&,fcnt&:Déclarer n&:n&=findInX(fac&)

    Si n&=-1:Inc cnt&:x&[cnt&]=fac&:xc&[cnt&]=fcnt&:D'autre :Cas xc&[n&]<fcnt&:xc&[n&]=fcnt&:EndIf

    ENDPROC

    Proc sum:var erg!=0

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

            :WhileLoop 1,SizeOf(x&[])-1:erg!=erg!*x&[&loop]^xc&[&loop]:Endwhile
            EndIf:Retour erg!

        ENDPROC

        Proc pfc :Paramètres n&:Déclarer fac&,fcnt&,diff&,t&:diff&=2:t&=5:fac&=2:fcnt&=0

            :Whilenot n& mod 2:inc fcnt&:n&=n& \2:Endwhile:Cas fcnt&>0:addInX(2,fcnt&)
            fac&=3:fcnt&=0:Whilenot n& mod 3:inc fcnt&:n&=n& \3:Endwhile:Cas fcnt&>0:addInX(3,fcnt&)

            Tandis que sqr(t&)<=n&:fcnt&=0:Whilenot n& mod t&:inc fcnt&:n&=n& \t&:Endwhile

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

            ENDPROC

            Proc kgV'Kleinstes gemeinsames Vielfaches. Erlaubt 2 jusqu'à 9 paramètre:

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

                Select %PCount

                    CaseOf 9:Paramètres 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&:Retour sum()

                    CaseOf 8:Paramètres a8&,b8&,c8&,d8&,e8&,f8&,g8&,h8&

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

                    CaseOf 7:Paramètres a7&,b7&,c7&,d7&,e7&,f7&,g7&

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

                    CaseOf 6:Paramètres a6&,b6&,c6&,d6&,e6&,f6&

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

                    CaseOf 5:Paramètres a5&,b5&,c5&,d5&,e5&:pfc a5&: pfc b5&: pfc c5&: pfc d5&: pfc e5&:Retour sum()

                    CaseOf 4:Paramètres a4&,b4&,c4&,d4&:pfc a4& : pfc b4& : pfc c4& : pfc d4&:Retour sum()

                    CaseOf 3:Paramètres a3&,b3&,c3&:pfc a3& : pfc b3& : pfc c3&:Retour sum()

                    CaseOf 2:Paramètres a2&,b2&:pfc a2&: pfc b2&:Retour sum()

                    EndSelect:Retour 0.0

                ENDPROC

                Proc ggT2 :Paramètres a&,b&' Größter gemeinsamer Teiler, 2 paramètre

                    Déclarer t& :si b&>a&:t&=a&:a&=b&:b&=t&:endif:Casenot b&:Retour a& : Retour ggT2(b&,a& mod b&)

                ENDPROC

                Proc ggT' Größter gemeinsamer Teiler. 1 jusqu'à 9 paramètre

                    Select %PCount

                        CaseOf 9:Paramètres a9&,b9&,c9&,d9&,e9&,f9&,g9&,h9&,i9&

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

                        CaseOf 8:Paramètres a8&,b8&,c8&,d8&,e8&,f8&,g8&,h8&

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

                        CaseOf 7:Paramètres a7&,b7&,c7&,d7&,e7&,f7&,g7&

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

                        CaseOf 6:Paramètres a6&,b6&,c6&,d6&,e6&,f6&

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

                        CaseOf 5:Paramètres a5&,b5&,c5&,d5&,e5&

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

                        CaseOf 4:Paramètres a4&,b4&,c4&,d4&:Retour ggT2(ggT2(ggT2(a4&,b4&),c4&),d4&)

                        CaseOf 3:Paramètres a3&,b3&,c3&:Retour ggT2(ggT2(a3&,b3&),c3&)

                        CaseOf 2:Paramètres a2&,b2&:Retour ggT2(a2&,b2&)

                        CaseOf 1:Paramètres a1&:Retour a1&

                        EndSelect:Retour 0

                    ENDPROC

                    Proc kgV_aus_ggT :var erg!=0

                        '' Statt Abstreich-Methode peux kgV aussi mittels "Summe par ggT" ermittelt volonté. Bsp.:
                        '  Imprimer "kgV_aus_ggT(53667,459486)=";format$("%d",kgV_aus_ggT(53667,459486))
                        '  Imprimer "kgV_aus_ggT(62,36)=";format$("%d",kgV_aus_ggT(62,36))

                        Select %PCount

                            CaseOf 9:Paramètres 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:Paramètres 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:Paramètres 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:Paramètres a6&,b6&,c6&,d6&,e6&,f6&

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

                            CaseOf 5:Paramètres a5&,b5&,c5&,d5&,e5&:erg!=a5&*b5&*c5&*d5&*e5& / ggT(a5&,b5&,c5&,d5&,e5&)

                            CaseOf 4:Paramètres a4&,b4&,c4&,d4&:erg!=a4&*b4&*c4&*d4& / ggT(a4&,b4&,c4&,d4&)

                            CaseOf 3:Paramètres a3&,b3&,c3&:erg!=a3&*b3&*c3& / ggT(a3&,b3&,c3&)

                            CaseOf 2:Paramètres a2&,b2&:erg!=a2&*b2& / ggT(a2&,b2&)

                            CaseOf 1:Paramètres a1&:erg!=a1&

                            EndSelect:Retour erg!

                        ENDPROC

                        ' Hauptprogramm:
                        Imprimer "\n\n T E S T :"
                        declare x&,y&,i&,j&,e&,path$,limit&,limit$
                        declare PFactor&[]
                        imprimer "\n\n kgV(53667,459486)=";format$("%d",kgV(53667,459486))
                        imprimer " kgV_aus_ggt(53667,459486)=";format$("%d",kgV_aus_ggT(53667,459486))
                        imprimer " ----------------------------------------------------------------------"
                        x&=62 : y&=36 :imprimer "\n ggT2(";x&;»;y&;")=",ggT(x&,y&)
                        x&=1023 : y&=99 :imprimer " ggT2(";x&;»;y&;")=",ggT(x&,y&)
                        x&=1071 : y&=1029 :imprimer " ggT2(";x&;»;y&;")=",ggT(x&,y&)
                        imprimer " -------"
                        imprimer "\n ggT(1023,99,1071,1029)=",ggT(1023,99,1071,1029)
                        imprimer " ggT(15400,7875,3850)=",ggT(15400,7875,3850)
                        font 2:imprimer "\n ----------------------------------------------------------"
                        66EA1F72BEC94EAEA8A150F6BC904FA2:
                        Imprimer "\n sur PRIM trop testende numéro: ";:input limit$

                        si val(limit$)>(2^31-1):imprimer "Zu grand!":sound 800,100:goto "66EA1F72BEC94EAEA8A150F6BC904FA2":endif

                            limit&=val(limit$)
                            locate %csrlin-1,45:imprimer si(isPrim(limit&)," <<< ist PRIM!"," <<< ist pas prim.")
                            imprimer "\n ---------------------- [Start] ----------------------------"
                            Imprimer "\n Zerlegungen volonté dans Dossier dem Desktop geschrieben."
                            Imprimer "\n jusque quel Obergrenze devoir qui Faktoren ermittelt volonté? "
                            imprimer "\n Limit = ";:input limit&:imprimer
                            path$=getenv$("USERPROFILE")+"\DESKTOP\Primfaktoren.txt":e&=%IOResult
                            Assign #1,path$:e&=%IOResult
                            Rewrite #1:e&=%IOResult

                            si e&:Imprimer "Problem beim écrivons qui Dossier "+path$:waitinput:sound 1000,200:Fin:Endif

                                Imprimer  "\n données volonté soeben geschrieben pour: ";path$
                                cas limit&<=3000:Imprimer  "\n Primfaktoren (2.."+str$(limit&)+")"
                                Imprimer #1,"Datei qui Primfaktoren de 2 jusqu'à "+str$(limit&)
                                'WhileLoop 20000,limit&

                                WhileLoop 2,limit&

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

                                    Tandis que i&<j&

                                        cas limit&<=3000:Imprimer  » + si(i&=0,»,"·"); PFactor&[i&];
                                        Imprimer #1,» + si(i&=0,»,"·"); PFactor&[i&];
                                        Inc i&

                                    Endwhile

                                    Claire PFactor&[]
                                    cas limit&<=3000:Imprimer  »+si(IsPrim(&loop)," PRIM",»);
                                    Imprimer #1,»+si(IsPrim(&loop)," PRIM",»);

                                Endwhile

                                Imprimer #1,"\nEOF":e&=%IOResult
                                Fermer #1:e&=%IOResult
                                Imprimer  "\n données wurden geschrieben pour: ";path$:sound 2000,90
                                Imprimer "\n Ende":WaitInput:Fin