chap01.ari000640 000766 000024 00000003356 12641720654 012772 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 1 ** Die Peano-Axiome *) (*----------------------------------------------------------*) (* ** Rekursive Definition der Adition zweier ** natuerlicher Zahlen x,y ** Fuer das korrekte Funktionieren ist wesentlich, dass y >= 0 *) function p_add(x,y: integer): integer; var z: integer; begin if y = 0 then return x; else z := p_add(x,dec(y)); return inc(z); end; end; (*----------------------------------------------------------*) (* ** Rekursive Definition der Multiplikation zweier ** natuerlicher Zahlen x,y ** Fuer das korrekte Funktionieren ist wesentlich, dass y >= 0 ** Sehr langsam! *) function p_mult(x,y: integer): integer; var z: integer; begin if y = 0 then return 0; else z := p_mult(x,dec(y)); return p_add(z,x); end; end; (*----------------------------------------------------------*) (* ** Rekursive Definition der Potenz x**y ** zweier natuerlicher Zahlen x,y ** Fuer das korrekte Funktionieren ist wesentlich, dass y >= 0 *) function p_pow(x,y: integer): integer; var z: integer; begin if y = 0 then return 1; else z := p_pow(x,dec(y)); return z * x; end; end; (*----------------------------------------------------------*) (* ** Liefert genau dann true, wenn x < y *) function p_less(x,y: integer): boolean; begin if x = 0 then return not (y = 0); elsif y = 0 then return false; else return p_less(dec(x),dec(y)); end; end; (*----------------------------------------------------------*) chap02.ari000640 000766 000024 00000007537 12641720654 013000 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 2 ** Die Grundrechnungs-Arten *) (*----------------------------------------------------------*) (* ** Zurueckfuehrung der Addition von nicht-negativen ganzen Zahlen ** auf Bit-Operationen *) function add(x,y: integer): integer; var x0: integer; begin while y > 0 do x0 := x; x := bit_xor(x,y); y := bit_shift(bit_and(x0,y),1); end; return x; end. (*-------------------------------------------------------------------*) (* ** Version von add mit Ausgabe der Zwischen-Ergebnisse ** in Basis 2 Darstellung *) function add_verbose(x,y: integer): integer; var x0, N: integer; begin N := max(bit_length(x),bit_length(y)) + 1; while y > 0 do writeln(x:base(2):digits(N)); writeln(y:base(2):digits(N)); writeln(); x0 := x; x := bit_xor(x,y); y := bit_shift(bit_and(x0,y),1); end; writeln(x:base(2):digits(N)); return x; end. (*-------------------------------------------------------------------*) (* ** Zurueckfuehrung der Multiplikation ganzer Zahlen ** auf Additionen und Bit-Operationen. ** Die Faktoren werden als nicht-negativ vorausgesetzt. *) function mult(x,y: integer): integer; var z: integer; begin z := 0; while y > 0 do if odd(y) then z := z + x; end; x := bit_shift(x,1); y := bit_shift(y,-1); end; return z; end. (*-------------------------------------------------------------------*) (* ** Schneller Algorithmus fuer die Potenzierung ** Der Exponent n wird als nicht-negativ vorausgesetzt *) function power(x,n: integer): integer; var k, pow: integer; begin if n = 0 then return 1; end; pow := x; for k := bit_length(n)-2 to 0 by -1 do pow := pow * pow; if bit_test(n,k) then pow := pow * x; end; end; return pow; end. (*-------------------------------------------------------------------*) (* ** Zurueckfuehrung der ganzzahligen Division auf Additionen, ** Subtraktionen und Bit-Operationen. ** Die Argumente werden als nicht-negativ vorausgesetzt. *) function eucl_div(x,y: integer): array[2] of integer; var quot, b: integer; begin quot := 0; b := 1; while y < x do y := bit_shift(y,1); b := bit_shift(b,1); end; while b > 0 do if x >= y then x := x - y; quot := quot + b; end; y := bit_shift(y,-1); b := bit_shift(b,-1); end; return (quot, x); end. (*-------------------------------------------------------------------*) (* ** Algorithmus fuer die ganzzahlige Quadratwurzel mittels ** Newton-Verfahren. ** Falls der Radikand a, der als nicht-negativ vorausgesetzt wird, ** sehr gross ist, sind die gewaehlten Anfangswerte x, y ** fuer die Iteration unguenstig. Fuer eine bessere Wahl siehe rt1 *) function rt(a: integer): integer; var x,y: integer; begin x := a; y := 1; while x > y do x := (x+y) div 2; y := a div x; end; return x; end. (*-------------------------------------------------------------------*) (* ** Verbesserte Fassung von rt durch bessere Wahl der Anfangswerte ** fuer die Iteration ** Bemerkung: Auch als eingebaute ARIBAS-Funktion ** mit dem Namen isqrt vorhanden. *) function rt1(a: integer): integer; var x,y,n: integer; begin if a < 0 then writeln("error"); writeln("square root: radicand must be non-negative: ",a); return 0; end; n := bit_length(a); x := bit_shift(1,(n+1) div 2); y := a div x; while x > y do x := (x+y) div 2; y := a div x; end; return x; end. (*-------------------------------------------------------------------*) chap03.ari000640 000766 000024 00000003365 12641720654 012774 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 3 ** Die Fibonacci-Zahlen *) (*------------------------------------------------------------------*) (* ** Berechnung der Fibonacci-Zahlen ** ** Anfangswerte: fib(0) = 0; fib(1) = 1; ** Rekusionsformel: fib(n) = fib(n-1) + fib(n-2) fuer n >= 2 *) (*------------------------------------------------------------------*) (* ** Rekursive Version, sehr langsam! *) function fib_rec(n: integer): integer; begin if n <= 1 then return n; else return fib_rec(n-1) + fib_rec(n-2); end; end; (*------------------------------------------------------------------*) (* ** Iterative Version *) function fib_it(n: integer): integer; var x, y, temp, i: integer; begin if n <= 1 then return n end; x := 1; y := 0; for i := 2 to n do temp := x; x := x + y; y := temp; end; return x; end; (*------------------------------------------------------------------*) (* ** Schnelle Berechnung der Fibonacci-Zahlen mittels der Formeln ** fib(2*n-1) = fib(n)**2 + fib(n-1)**2 ** fib(2*n) = fib(n)**2 + 2*fib(n)*fib(n-1) ** ** Beispiel-Aufruf: fib(1000). *) function fib(n: integer): integer; var k, x, y, xx, temp: integer; begin if n <= 1 then return n end; x := 1; y := 0; for k := bit_length(n)-2 to 0 by -1 do xx := x*x; x := xx + 2*x*y; y := xx + y*y; if bit_test(n,k) then temp := x; x := x + y; y := temp; end; end; return x; end. (*------------------------------------------------------------------*) chap04.ari000640 000766 000024 00000003050 12641720655 012765 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 4 ** Der Euklidische Algorithmus *) (*----------------------------------------------------------*) (* ** Berechnet den groessten gemeinsamen Teiler von x und y ** mit einer rekursiven Form des euklidischen Algorithmus *) function gcd_rec(x,y: integer): integer; begin if y = 0 then return abs(x); else return gcd_rec(y, x mod y); end; end; (*--------------------------------------------------------*) (* ** Iterative Form des euklidischen Algorithmus ** ** Bemerkung: Auch als eingebaute ARIBAS-Funktion mit ** dem Namen gcd vorhanden. *) function gcd_it(x,y: integer): integer; var temp: integer; begin while y /= 0 do temp := y; y := x mod y; x := temp; end; return abs(x); end; (*--------------------------------------------------------*) (* ** Berechnet ein Array (d,u,v), so dass ** d = gcd(x,y) ** und d = u*x + v*y. *) function gcd_coeff(x,y: integer): array[3]; var q, temp, q11, q12, q21, q22, t21, t22: integer; begin q11 := q22 := 1; q12 := q21 := 0; while y /= 0 do temp := y; q := x div y; y := x mod y; x := temp; t21 := q21; t22 := q22; q21 := q11 - q*q21; q22 := q12 - q*q22; q11 := t21; q12 := t22; end; return (x,q11,q12); end; (*--------------------------------------------------------*) chap05.ari000640 000766 000024 00000004050 12641720655 012767 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 5 ** Primfaktor-Zerlegung *) (*----------------------------------------------------------*) (* ** Sieb des Eratostenes. ** Das Argument N wird auf das naechst groessere Vielfache ** von 16 aufgerundet. ** Die Funktion liefert einen Bitvektor der Laenge N/2, ** (d.h. einen Byte-String der Laenge N/16), ** in der das Bit an Position k genau dann gesetzt ist, ** wenn 2*k+1 eine Primzahl ist. *) function erat_sieve(N: integer): byte_string; var p,k,n: integer; bb: byte_string; begin n := (N+15) div 16; N := n*16; bb := alloc(byte_string,n,0xFF); mem_bclear(bb,0); for p := 3 to isqrt(N) by 2 do if mem_btest(bb,p div 2) = 1 then for k := 3*p to N by 2*p do mem_bclear(bb,k div 2); end; end; end; return bb; end; (*--------------------------------------------------------*) (* ** stellt alle Primfaktoren von x, die kleiner als 2**16 sind, ** fest und gibt sie aus. ** Funktionswert: letzter Primfaktor oder letzter Cofaktor ** Ist dieser < 2**32, so ist er prim *) function factors(x: integer): integer; var q: integer; begin q := 2; while q := factor16(x,q) do writeln(q); x := x div q; end; return x; end; (*--------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) chap06.ari000640 000766 000024 00000003410 12641720655 012767 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 6 ** Der Restklassenring Z/mZ *) (*----------------------------------------------------------*) (* ** M ist ein Array ganzer Zahlen, die als positiv und ** paarweise teilerfremd vorausgesetzt werden. ** Die Funktion chin_arr ordnet einer ganzen Zahl x ** das Array der Restklassen modulo den Komponenten von M zu *) function chin_arr(x: integer; M: array): array; var X: array[length(M)]; i: integer; begin for i := 0 to length(M)-1 do X[i] := x mod M[i]; end; return X; end; (*---------------------------------------------------------*) (* ** Umkehrfunktion von chin_arr ** Die Komponenten des Arrays M muessen positiv ** und paarweise teilerfremd sein *) function chin_inv(X, M: array): integer; var m, m1, i, z: integer; begin m := product(M); z := 0; for i := 0 to length(M)-1 do m1 := m div M[i]; z := z + X[i] * m1 * mod_inverse(m1,M[i]); end; return z mod m; end; (*---------------------------------------------------------*) (* ** Komponentenweise Addition zweier Arrays X,Y modulo M *) function arr_add(X,Y,M: array): array; var i: integer; begin for i := 0 to length(X)-1 do X[i] := (X[i] + Y[i]) mod M[i]; end; return X; end; (*---------------------------------------------------------*) (* ** Komponentenweise Multiplikation zweier Arrays X,Y modulo M *) function arr_mult(X,Y,M: array): array; var i: integer; begin for i := 0 to length(X)-1 do X[i] := (X[i] * Y[i]) mod M[i]; end; return X; end; (*---------------------------------------------------------*) chap07.ari000640 000766 000024 00000001264 12641720655 012775 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 7 ** Die Saetze von Fermat, Euler und Wilson *) (*----------------------------------------------------------*) function mod_power(x,n,M: integer): integer; var k, pow: integer; begin if n = 0 then return 1; end; pow := x; for k := bit_length(n)-2 to 0 by -1 do pow := (pow * pow) mod M; if bit_test(n,k) then pow := (pow * x) mod M; end; end; return pow; end; (*********************************************************) chap08.ari000640 000766 000024 00000005400 12641720656 012773 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 8 ** Die Struktur von (Z/mZ)*, Primitivwurzeln *) (*----------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) (* ** Liefert fuer eine ganze Zahl x einen Vektor, ** dessen Komponenten die Primfaktoren von x sind. ** Mehrfache Faktoren werden nur einmal aufgezaehlt. ** Funktioniert nur, wenn x hoechstens einen Primfaktor > 2**16 ** hat, der aber < 2**32 sein muss. *) function primefactors(x: integer): array; var i,p,p0: integer; vec: array; st: stack; begin vec := factorlist(x); p0 := 0; for i := 0 to length(vec)-1 do p := vec[i]; if p /= p0 then stack_push(st,p); p0 := p; end; end; return stack2array(st); end; (*--------------------------------------------------------------*) function primroot(p: integer): integer; var i, b, m: integer; found: boolean; qvec: array; begin qvec := primefactors(p-1); for b := 2 to p-1 do found := true; for i := 0 to length(qvec)-1 do m := (p-1) div qvec[i]; if b**m mod p = 1 then found := false; break; end; end; if found then return b; end; end; return 0; (* this case should not happen *) end; (*--------------------------------------------------------------*) (* ** Liefert fuer eine ungerade Primzahl p ** die kleinste Primitivwurzel mod p ** Setzt voraus, dass p-1 von der Funktion primefactors ** vollstaendig faktorisiert werden kann. *) function primroot(p: integer): integer; var i, b, m: integer; found: boolean; qvec: array; begin qvec := primefactors(p-1); for b := 2 to p-1 do found := true; for i := 0 to length(qvec)-1 do m := (p-1) div qvec[i]; if b**m mod p = 1 then found := false; break; end; end; if found then return b; end; end; return 0; (* this case should not happen *) end; (*--------------------------------------------------------------*) chap09.ari000640 000766 000024 00000002020 12641720656 012767 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 9 ** Pseudo-Zufalls-Generatoren *) (*----------------------------------------------------------*) var RandSeed: integer; end; (*--------------------------------------------------*) function inirand(seed: integer): integer; external RandSeed: integer; begin RandSeed := bit_and(seed,0xFF_FFFF_FFFF); return RandSeed; end; (*--------------------------------------------------*) function nextrand(): integer; external RandSeed: integer; const alfa = 31459265; beta = 2718281; var x: integer; begin x := RandSeed*alfa + beta; RandSeed := bit_and(x,0xFF_FFFF_FFFF); return bit_shift(RandSeed,-8); end; (*--------------------------------------------------*) function rand(N: integer): integer; begin return nextrand() mod N; end; (*--------------------------------------------------*) chap10.ari000640 000766 000024 00000002760 12641720656 012772 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 10 ** Zur Umkehrung des Satzes von Fermat *) (*----------------------------------------------------------*) (* ** Schnelle Berechnung der Fibonacci-Zahlen mittels der Formeln ** fib(2*n-1) = fib(n)**2 + fib(n-1)**2 ** fib(2*n) = fib(n)**2 + 2*fib(n)*fib(n-1) *) function fib(n: integer): integer; var k, x, y, xx, temp: integer; begin if n <= 1 then return n end; x := 1; y := 0; for k := bit_length(n)-2 to 0 by -1 do xx := x*x; x := xx + 2*x*y; y := xx + y*y; if bit_test(n,k) then temp := x; x := x + y; y := temp; end; end; return x; end. (*------------------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) chap11.ari000640 000766 000024 00000002424 12641720656 012770 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 11 ** Quadratische Reste, quadratisches Reziprozitaetsgesetz *) (*-------------------------------------------------------------*) (* ** Berechnet das Legendre- bzw. Jacobi-Symbol von x ueber y. ** ** Bemerkung: Auch als eingebaute ARIBAS-Funktion mit ** dem Namen jacobi(x,y) vorhanden. *) function jac(x,y: integer): integer; var m8, temp, res: integer; begin if y < 3 or even(y) then writeln("jac(x,y): y must be an odd integer >= 3"); return 0; end; res := 1; while true do (* Schleifeninvariante res*jac(x,y) *) x := x mod y; if x = 0 then return 0; end; while even(x) do (* 2. Ergaenzungssatz *) x := x div 2; m8 := y mod 8; if (m8 = 3) or (m8 = 5) then res := -res; end; end; if x = 1 then return res; end; temp := x; x := y; y := temp; (* vertausche x,y; Reziprozitaetsgesetz *) if (x mod 4 = 3) and (y mod 4 = 3) then res := -res; end; end; end; (*-------------------------------------------------------------*) chap12.ari000640 000766 000024 00000003126 12641720656 012771 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 12 ** Probabilistische Primzahltests *) (*----------------------------------------------------------*) (* ** Solovay-Strassen-Primzahltest ** Dies ist ein probabilistischer Primzahltest. ** Beim Ergebnis false ist x sicher keine Primzahl; ** beim Ergebnis true ist x nur wahrscheinlich eine Primzahl. ** Zur Erhoehung der Wahrscheinlichkeit kann der Test wiederholt werden. *) function ss_test(N: integer): boolean; var a, j, u: integer; begin if even(N) then return false end; a := 2 + random(64000); j := jacobi(a,N); u := a ** (N div 2) mod N; if j = 1 and u = 1 then return true; elsif j = -1 and N-u = 1 then return true; else return false; end; end; (*----------------------------------------------------*) (* ** probabilistischer Primzahltest nach Miller-Rabin ** ** Bemerkung: Auch als eingebaute ARIBAS-Funktion mit ** dem Namen rab_primetest(N) vorhanden. *) function rab_test(N: integer): boolean; var k, n, t, u, a: integer; begin if even(N) then return false end; n := N div 2; t := 1; while even(n) do n := n div 2; inc(t); end; a := 2 + random(64000); u := a ** n mod N; if u = 1 or N-u = 1 then return true end; for k := 1 to t-1 do u := u*u mod N; if N-u = 1 then return true end; end; return false; end; (*----------------------------------------------------*) chap13.ari000640 000766 000024 00000003171 12641720657 012773 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 13 ** Die Pollardsche Rho-Methode *) (*----------------------------------------------------------*) (* ** Implementierung des Pollardschen Rho-Verfahrens zur Faktorisierung ** Bemerkung: In ARIBAS als eingebaute Funktion mit dem Namen ** rho_factorize vorhanden *) (*----------------------------------------------------------------*) (* ** Versucht, die Zahl N zu faktorisieren. Der Parameter anz ** ist eine Schranke fuer die Anzahl der Iterationen. ** Ein Faktor p von N wird im allgemeinen gefunden, falls ** anz groesser als die Quadratwurzel von p ist. *) function poll_rho(N,anz: integer): integer; const anz0 = 256; var x, y, i, d, P: integer; begin y := x := random(N); write("working "); for i := 0 to (anz-1) div anz0 do P := accumdiff(x,y,N,anz0); write('.'); d := gcd(P,N); if d > 1 and d < N then writeln(); writeln("factor found after "); writeln((i+1)*anz0," iterations"); return(d); end; end; return 0; end; (*----------------------------------------------------------------*) function accumdiff(var x,y: integer; N, anz: integer): integer; var i, P: integer; begin P := 1; for i := 1 to anz do x := (x*x + 2) mod N; y := (y*y + 2) mod N; y := (y*y + 2) mod N; P := P * (y-x) mod N; end; return P; end; (*----------------------------------------------------------------*) chap14.ari000640 000766 000024 00000010741 12641720657 012775 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 14 ** Die (p-1)-Faktorisierungs-Methode *) (*----------------------------------------------------------*) (* ** Produkt aller Primzahlen B0 < p <= B1 ** und aller ganzen Zahlen isqrt(B0) < n <= isqrt(B1) ** Diese Funktion wird gebraucht von den Funktionen ** p1_factorize, pp1_factorize und ec_factorize *) function ppexpo(B0,B1: integer): integer; var x, m0, m1, i: integer; begin x := 1; m0 := max(2,isqrt(B0)+1); m1 := isqrt(B1); for i := m0 to m1 do x := x*i; end; if odd(B0) then inc(B0) end; for i := B0+1 to B1 by 2 do if prime32test(i) > 0 then x := x*i end; end; return x; end; (*-----------------------------------------------------*) (* ** p-1-Faktorisierungs-Algorithmus von Pollard ** Findet i.a. Primfaktoren p von x, wenn p-1 Produkt ** kleiner Primzahlen q <= bound ist. ** Fuer einen ersten Versuch bei 30-stelligem x ** waehle z.B. bound = 16000. *) function p1_factorize(N,bound: integer): integer; const anz0 = 128; var base, d, B0, B1, ex: integer; begin base := 2 + random(N-2); if (d := gcd(base,N)) > 1 then return d end; write("working "); for B0 := 0 to bound-1 by anz0 do B1 := min(B0+anz0, bound); ex := ppexpo(B0,B1); base := base ** ex mod N; if base = 1 then return 0 end; write('.'); d := gcd(base-1,N); if d > 1 then writeln(); writeln("factor found with bound ",B1); return d; end; end; return 0; end; (*-----------------------------------------------------*) (* ** Berechnet die Differenzen aufeinander folgender ** Primzahlen <= N und schreibt jeweils die Maxima ** der Differenzen auf den Bildschirm ** Rueckgabewert ist die Anzahl aller Primzahlen <= N *) function primdiff(N: integer): integer; var count, prime, prime0, diff, maxdiff: integer; begin prime0 := 3; count := 0; maxdiff := 0; while prime0 <= N do inc(count); prime := next_prime(prime0 + 2); diff := prime - prime0; if diff > maxdiff then maxdiff := diff; writeln(diff:6,": ",prime); end; prime0 := prime; end; return count; end; (*-----------------------------------------------------*) (* ** Hilfsfunktion fuer die (p-1)-Faktorisierung ** mit big prime variation; siehe ** p1_factbpv() *) function bigprimevar(y,N,bound: integer): integer; const maxbound = 10**7; maxhdiff = 77; var X: array[maxhdiff+1]; i, k, y2, q, q0, d, z, count: integer; begin X[0] := 1; y2 := y*y mod N; for i:=1 to maxhdiff do X[i] := X[i-1]*y2 mod N; end; bound := min(bound,maxbound); q0 := 3; y := y**q0 mod N; z := y-1; count := 0; while q0 < bound do q := next_prime(q0+2); k := (q-q0) div 2; y := y*X[k] mod N; z := z*(y-1) mod N; if inc(count) >= 1000 then write('.'); count := 0; d := gcd(z,N); if d > 1 then return d; end; end; q0 := q; end; return 0; end; (*-----------------------------------------------------*) (* ** (p-1)-Faktorisierung mit big prime variation ** bound2 ist Schranke fuer die "big primes" *) function p1_factbpv(N,bound1,bound2: integer): integer; var base, d, ex, B0: integer; begin base := 2 + random(N-2); write("working "); for B0 := 0 to bound1-1 by 256 do ex := ppexpo(B0,min(B0+256,bound1)); base := base**ex mod N; d := gcd(base-1,N); write('.'); if d > 1 then return d; end; end; if d = 1 then writeln(); write("entering big prime variation "); d := bigprimevar(base,N,bound2); end; return d; end. (*-----------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) chap15.ari000640 000766 000024 00000001014 12641720657 012767 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 15 ** Das RSA-Kryptographie-Verfahren *) (*----------------------------------------------------------*) (* ** Die fuer Par. 15 benoetigten Funktionen wie ** random(), next_prime(), mod_inverse() u.s.w. ** sind alles eingebaute ARIBAS-Funktionen. *) (*----------------------------------------------------------*) chap16.ari000640 000766 000024 00000003656 12641720657 013006 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 16 ** Quadratische Erweiterungen *) (*----------------------------------------------------------*) (* ** Wurzelziehen modulo p *) (*----------------------------------------------------------*) (* ** Quadratwurzel von a mod p ** Voraussetzung: p ungerade Primzahl, jacobi(a,p) = 1. ** ** Bemerkung: Auch als eingebaute ARIBAS-Funktion ** mit Namen gfp_sqrt(p,a) vorhanden. *) function fp_sqrt(p,a: integer): integer; begin if p mod 4 = 1 then return fp_sqrt1(p,a); else (* p = 3 mod 4 *) return a ** ((p+1) div 4) mod p; end; end; (*----------------------------------------------------------*) (* ** Quadratwurzel von a mod p ** Voraussetzung: p ungerade Primzahl = 1 mod 4, jacobi(a,p) = 1. *) function fp_sqrt1(p,a: integer): integer; var b: integer; x: array[2]; begin b := 1; while jacobi(b*b-a,p) /= -1 do inc(b) end; x := fp2_pow(p, b*b-a, (b,1), (p+1) div 2); return x[0]; end; (*----------------------------------------------------------*) function fp2_mult(p,D: integer; x,y: array[2]): array[2]; var z0, z1: integer; begin z0 := x[0]*y[0] + D*x[1]*y[1]; z1 := x[0]*y[1] + x[1]*y[0]; return (z0 mod p, z1 mod p); end; (*----------------------------------------------------------*) (* ** Potenz x**ex im Koerper Fp(sqrt(D)), jacobi(D,p) = -1 ** Voraussetzung ex >= 0. *) function fp2_pow(p,D: integer; x: array[2]; N: integer): array[2]; var i: integer; z: array[2]; begin if N = 0 then return (1, 0); end; z := x; for i := bit_length(N)-2 to 0 by -1 do z := fp2_mult(p,D,z,z); if bit_test(N,i) then z := fp2_mult(p,D,z,x); end; end; return z; end; (*----------------------------------------------------------*) chap17.ari000640 000766 000024 00000001306 12641720660 012767 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 17 ** Der (p+1)-Primzahltest, Mersennesche Primzahlen *) (*--------------------------------------------------------------*) (* ** Lucas-Test fuer Mersennesche Primzahlen. ** Testet fuer ungerade Zahlen n >= 3, ob 2**n-1 eine Primzahl ist *) function mtest(n: integer): boolean; var M, k, v: integer; begin v := 4; M := 2**n - 1; for k := 1 to n-2 do v := (v*v - 2) mod M; end; return (v = 0); end. (*--------------------------------------------------------------*) chap18.ari000640 000766 000024 00000005065 12641720660 012776 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 18 ** Die (p+1)-Faktorisierungs-Methode *) (*----------------------------------------------------------*) (* ** stellt alle Primfaktoren von x, die kleiner als 2**16 sind, ** fest und gibt sie aus. ** Funktionswert: letzter Primfaktor oder letzter Cofaktor ** Ist dieser < 2**32, so ist er prim *) function factors(x: integer): integer; var q: integer; begin q := 2; while q := factor16(x,q) do writeln(q); x := x div q; end; return x; end; (*--------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) (* ** Produkt aller Primzahlen B0 < p <= B1 ** und aller ganzen Zahlen isqrt(B0) < n <= isqrt(B1) ** Diese Funktion wird gebraucht von den Funktionen ** p1_factorize, pp1_factorize und ec_factorize *) function ppexpo(B0,B1: integer): integer; var x, m0, m1, i: integer; begin x := 1; m0 := max(2,isqrt(B0)+1); m1 := isqrt(B1); for i := m0 to m1 do x := x*i; end; if odd(B0) then inc(B0) end; for i := B0+1 to B1 by 2 do if prime32test(i) > 0 then x := x*i end; end; return x; end; (*-----------------------------------------------------*) (* ** (p+1)-Faktorisierungsmethode *) function pp1_factorize(N,bound: integer): integer; const anz0 = 128; var a, d, n, B0, B1, ex: integer; begin a := 2 + random(N-3); if (d := gcd(a*a-1,N)) > 1 then return d end; write("working "); for B0 := 0 to bound-1 by anz0 do B1 := min(B0+anz0, bound); ex := ppexpo(B0,B1); a := mod_coshmult(a,ex,N); if a = 1 then return 0 end; write('.'); d := gcd(a-1,N); if d > 1 then writeln(); writeln("factor found with bound ",B1); return d; end; end; return 0; end. (*-----------------------------------------------------*) chap19.ari000640 000766 000024 00000006626 12641720660 013003 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 19 ** Schnelle Fourier-Transformation *) (*----------------------------------------------------------*) function bitreverse(x,d: integer): integer; var i, z: integer; begin for i := 0 to d-1 do if bit_test(x,i) then z := bit_set(z,d-i-1); end; end; return z; end; (*----------------------------------------------------------*) function brevorder(var X: array; N: integer): array; var d,i,k,temp: integer; begin d := bit_length(N) - 1; for i := 0 to N-1 do k := bitreverse(i,d); if i < k then temp := X[i]; X[i] := X[k]; X[k] := temp; end; end; return X; end; (*----------------------------------------------------------*) (* ** Fourier-Transformation des Arrays X ueber Z/M. ** Das Array muss die Laenge N haben, das eine Zweierpotenz sein muss. ** omega muss eine primitive N-te Einheitswurzel mod M sein. *) function fft(var X: array; N, omega, M: integer): array; var n, m, m2, i, i0, i1, k, z, rho, rr: integer; begin brevorder(X,N); n := bit_length(N) - 1; (* N = 2**n *) for k := 0 to n-1 do m := 2**k; m2 := 2*m; rr := 1; rho := omega**(2**(n-k-1)) mod M; (* rho ist primitive m2-te Einheitswurzel *) for i := 0 to m-1 do for i0 := i to N-1 by m2 do i1 := i0 + m; z := (X[i1] * rr) mod M; (* rr = rho**i *) X[i1] := (X[i0] - z) mod M; X[i0] := (X[i0] + z) mod M; end; rr := rr * rho mod M; end; end; return X; end; (*----------------------------------------------------------*) function fftinv(var X: array; N, omega, M: integer): array; var i, s: integer; begin omega := mod_inverse(omega,M); s := mod_inverse(N,M); fft(X,N,omega,M); for i := 0 to N-1 do X[i] := s * X[i] mod M; end; return X; end; (*----------------------------------------------------------*) function fft_square(x: integer): integer; const Modul = 2**32 - 2**20 + 1; (* Primzahl *) Primroot = 19; (* Primitivwurzel mod Modul *) var X: array; N, i, s, omega: integer; begin X := int2fftarr(x); N := length(X); s := (Modul - 1) div N; omega := Primroot**s mod Modul; fft(X,N,omega,Modul); for i := 0 to N-1 do X[i] := X[i] ** 2 mod Modul; end; fftinv(X,N,omega,Modul); return fftarr2int(X); end; (*----------------------------------------------------------*) function int2fftarr(x: integer): array; var bb: byte_string; X: array; len, k, i: integer; begin bb := byte_string(x); len := length(bb); k := bit_length(len-1); (* len <= 2**k *) X := alloc(array,2**(k+1),0); for i := 0 to len-1 do X[i] := bb[i]; end; return X; end; (*----------------------------------------------------------*) function fftarr2int(var X: array): integer; var bb: byte_string[length(X)]; len, i: integer; begin len := length(X); for i := 0 to len-2 do X[i+1] := X[i+1] + bit_shift(X[i],-8); X[i] := bit_and(X[i],0xFF); end; for i := 0 to len-1 do bb[i] := X[i]; end; return cardinal(bb); end; (*----------------------------------------------------------*) chap20.ari000640 000766 000024 00000027021 12642521514 012761 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 20 ** Faktorisierung mit dem quadratischen Sieb *) (*----------------------------------------------------------*) function make_factorbase(N,len): array; var k,p: integer; fb: array; begin fb := alloc(array,len); fb[0] := -1; fb[1] := 2; p := 1; for k := 2 to len-1 do p := next_prime(p+2); while jacobi(N,p) /= 1 do p := next_prime(p+2); end; fb[k] := p; end; return fb; end; (*----------------------------------------------------------*) function rtpvec(N: integer; pvec: array): array; var x, p, k, len: integer; rvec: array begin len := length(pvec); rvec := alloc(array,len); rvec[0] := rvec[1] := 1; for k := 2 to len-1 do p := pvec[k]; rvec[k] := gfp_sqrt(p,N); end; return rvec; end; (*------------------------------------------------------------*) (* Typ-Deklaration, verwendet von der Funktion make_quadpol() *) type quadpol = record q,a,b,c: integer; end; end; (*----------------------------------------------------------*) function make_quadpol(N,q: integer): quadpol; var QQ: quadpol; begin q := next_prime(q,0); while jacobi(N,q) /= 1 do q := next_prime(q+2,0); end; QQ.q := q; QQ.a := q**2; QQ.b := Zp2_sqrt(q,N); QQ.c := (QQ.b**2 - N) div QQ.a; return QQ; end; (*----------------------------------------------------------*) (* ** Wurzel von n modulo p**2 ** Voraussetzung: n ist quadratischer Rest modulo p *) function Zp2_sqrt(p,n: integer): integer; var x0, xi, x: integer; begin x0 := gfp_sqrt(p,n); xi := mod_inverse(2*x0,p**2); x := (x0**2 + n)*xi; return (x mod p**2); end; (*----------------------------------------------------------*) (* Skalierungsfaktor fuer den Logarithmus in log_pvec() *) const Scal = 128; end; (*----------------------------------------------------------*) function logpvec(pvec: array): array; external Scal: integer; var k,len: integer; lvec: array of integer; begin len := length(pvec); lvec := alloc(array,len); lvec[0] := 0; for k := 1 to len-1 do lvec[k] := round(log(pvec[k])*Scal); end; return lvec; end; (*----------------------------------------------------------*) (* ** Globale Variablen *) var Num: integer; Mat: array of byte_string; Pivot,Vvec,Uvec: array of integer; Fbas,Rvec,Lvec,Sieve: array of integer; Flen,Srange,Startq,CurRow,Count1,Count2: integer; StackUV: stack; end; (*----------------------------------------------------------*) function QSinitialize(N: integer): integer; external Num, Flen, Srange, Startq, CurRow, Count1, Count2: integer; Mat: array of byte_string; Fbas, Rvec, Lvec, Sieve, Pivot, Uvec, Vvec: array; StackUV: stack; var blen, i: integer; bb: byte_string; begin Num := N; blen := bit_length(N); Flen := max(8,blen**2 div 32); Srange := min(blen*256, (max_arraysize()-1) div 2); Startq := isqrt(isqrt(2*N) div Srange); Fbas := make_factorbase(N,Flen); Rvec := rtpvec(N,Fbas); Lvec := logpvec(Fbas); bb := alloc(byte_string,(Flen div 4)+1); Mat := alloc(array,Flen+1,bb); Pivot := alloc(array,Flen); for i := 0 to Flen-1 do Pivot[i] := i end; CurRow := 0; Count1 := Count2 := 0; Vvec := Uvec := alloc(array,Flen+1); Sieve := alloc(array,2*Srange); stack_reset(StackUV); return Flen; end; (*----------------------------------------------------------*) (* ** Faktorisierung mit dem Quadratischen Sieb, Hauptfunktion ** ** Bemerkung: Auch als eingebaute ARIBAS-Funktion mit ** dem Namen qs_factorize(N) vorhanden. *) function QSfactorize(N: integer): integer; external Fbas, Uvec, Vvec: array; CurRow, Flen, Srange, Count1, Count2: integer; var u, v, d, nbfail: integer; relvec: array; begin QSinitialize(N); writeln("quadratic sieve length ",2*Srange, ", factorbase 2 ... ",Fbas[Flen-1]," of length ",Flen-1); write("working "); nbfail := 0; while nbfail < 32 do (u,v) := get_qres(N); if not qr_trialdiv(v) then continue; end; Uvec[CurRow] := u; Vvec[CurRow] := v; if gausselim(CurRow) = 0 then inc(CurRow); write('.'); else relvec := getrel(CurRow); write('!'); d := findfactor(N,relvec); if d > 0 then writeln(); writeln(Count1," polynomials, ",Count2, " completely factorized quadratic residues"); return d; else inc(nbfail); end; end; end; return 0; end; (*----------------------------------------------------------*) function get_qres(N: integer): array[2]; external Startq, Count1: integer; StackUV: stack; var Q: quadpol; UV: array; begin while stack_empty(StackUV) do Q := make_quadpol(N,Startq); inc(Count1); write('_'); dosieve(Q); sieveresults(Q); Startq := Q.q + 2; end; UV := stack_pop(StackUV); return UV; end; (*----------------------------------------------------------*) function dosieve(Q: quadpol) external Sieve, Fbas, Rvec, Lvec: array; Srange, Flen: integer; var i,i0,k,p,r,r1,r2,s,z,a1,b1: integer; begin for i := 0 to 2*Srange-1 do Sieve[i] := 0; end; for k := 2 to Flen-1 do p := Fbas[k]; z := Lvec[k]; r := Rvec[k]; s := (-Srange) mod p; if Q.a mod p /= 0 then a1 := mod_inverse(Q.a,p); b1 := Q.b mod p; r1 := (r - b1)*a1 mod p; if r1 >= s then i0 := r1-s else i0 := p+r1-s end; for i := i0 to 2*Srange-1 by p do Sieve[i] := Sieve[i] + z; end; r2 := (p - r - b1)*a1 mod p; if r2 >= s then i0 := r2-s else i0 := p+r2-s end; for i := i0 to 2*Srange-1 by p do Sieve[i] := Sieve[i] + z; end; end; end; end; (*----------------------------------------------------------*) function sieveresults(Q: quadpol): integer; external Num, Srange, Flen, Scal: integer; Sieve, Lvec: array; StackUV: stack; var k, x, u, v, target, qinv: integer; begin target := round(log(Num/Q.a)*Scal) - Lvec[Flen-1]; qinv := mod_inverse(Q.q,Num); for k := 0 to 2*Srange-1 do if Sieve[k] >= target then x := k - Srange; u := Q.a * x + Q.b; v := (u + Q.b) * x + Q.c; u := qinv*u mod Num; stack_push(StackUV,(u,v)); end; end; return length(StackUV); end; (*----------------------------------------------------------*) function qr_trialdiv(v: integer): boolean external Mat: array of byte_string; Fbas: array; Flen, CurRow, Count2: integer; var i, m, p: integer; begin mem_xor(Mat[CurRow],Mat[CurRow]); if v < 0 then v := -v; mem_bset(Mat[CurRow],0) end; for i := 1 to Flen-1 do p := Fbas[i]; m := 0; while (v > 1) and (v mod p = 0) do v := v div p; inc(m); end; if odd(m) then mem_bset(Mat[CurRow],i) end; if v <= 1 then mem_bset(Mat[CurRow],Flen+CurRow); inc(Count2); return true; end; end; return false; end; (*----------------------------------------------------------*) function gausselim(k: integer): integer; external Mat: array of byte_string; Pivot: array; var i,j,j0: integer; begin for i := 0 to k-1 do if mem_btest(Mat[k],Pivot[i]) then mem_xor(Mat[k],Mat[i]); end; end; for i := k to length(Pivot)-1 do j := Pivot[i]; if mem_btest(Mat[k],j) then j0 := Pivot[k]; Pivot[k] := j; Pivot[i] := j0; return 0; end; end; return 1; end. (*----------------------------------------------------------*) function getrel(row: integer): array; external Mat: array of byte_string; Flen: integer; var i: integer; st: stack; begin for i := 0 to row do if mem_btest(Mat[row],Flen+i) then stack_push(st,i); end; end; return stack2array(st); end; (*----------------------------------------------------------*) function findfactor(N: integer; relvec: array): integer; external Uvec, Vvec: array; var i,k,u,v,v1,x,y,d: integer; begin k := relvec[0]; x := Uvec[k]; v := Vvec[k]; y := 1; for i := 1 to length(relvec)-1 do k := relvec[i]; u := Uvec[k]; v1 := Vvec[k] x := (x * u) mod N; d := gcd(v,v1); v := (v div d) * (v1 div d); y := (y * d) mod N; end; y := (y*isqrt(v)) mod N; d := gcd(x+y,N); if d <= 1 or d = N then d := 0 end; return d; end; (*----------------------------------------------------------*) (* ** Constructs an array of the prime factors of x, ** where multiple prime factors are listed repeatedly ** according to their multiplicity ** Uses rho_factorize and qs_factorize ** *) function factorlist(x: integer): array; var st, st1: stack; q, y, bound: integer; vec: array; count: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; if x < 2**32 then stack_push(st,x); else stack_push(st1,x); end; while not stack_empty(st1) do x := stack_pop(st1); if rab_primetest(x) then stack_push(st,x); else bound := bit_length(x); bound := 4*bound**2; y := rho_factorize(x,bound,0); count := 0; while (y <= 1 or y >= x) do if inc(count) > 2 then writeln("unable to factorize ",x); halt(-1); end; y := qs_factorize(x,0); end; stack_push(st1,x div y); stack_push(st1,y); end; end; vec := stack2array(st); return sort(vec); end; (*---------------------------------------------------------*) (* ** Verbose version of factorlist *) function factorlistv(x: integer): array; var st, st1: stack; q, y, bound: integer; vec: array; count: integer; begin x := abs(x); if x < 2 then return {x}; end; q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; writeln(q); end; if x < 2**32 then stack_push(st,x); writeln(x); else stack_push(st1,x); end; while not stack_empty(st1) do x := stack_pop(st1); if rab_primetest(x) then stack_push(st,x); writeln(x); else bound := bit_length(x); bound := 4*bound**2; writeln("trying to factorize ",x," using Pollard rho") y := rho_factorize(x,bound); count := 0; while (y <= 1 or y >= x) do if inc(count) > 2 then writeln("unable to factorize ",x); halt(-1); end; writeln("trying to factorize ",x, " using quadratic sieve"); y := qs_factorize(x); end; writeln("found factor ",y); stack_push(st1,x div y); stack_push(st1,y); end; end; vec := stack2array(st); return sort(vec); end; (*---------------------------------------------------------*) chap21.ari000640 000766 000024 00000017332 12641720660 012770 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 21 ** Der diskrete Logarithmus *) (*****************************************************************) (* ** Pollardsches Rho-Verfahren zu Berechnung des Diskreten Logarithmus. ** Voraussetzungen: p Primzahl, ** g erzeugt Untergruppe von (Z/p)* der Primzahlordnung q ** x Element dieser Untergruppe. ** Rueckgabewert: diskreter Logarithmus von x zur Basis g, ** d.h. ganze Zahl k mit x = g**k mod p, ** oder -1, falls Algorithmus scheitert *) function dlog_rho(p,g,x,q: integer): integer; var nu, mu,nu1,mu1,nu2,mu2,y,z,i: integer; found: boolean; begin nu1 := nu2 := 1; mu1 := mu2 := 1 + random(q-1); y := z := (g**mu1 mod p) * x mod p; found := false; for i := 1 to 10*isqrt(q) do y := lrho_step(p,g,x,y,q,nu1,mu1); z := lrho_step(p,g,x,z,q,nu2,mu2); z := lrho_step(p,g,x,z,q,nu2,mu2); if i mod 1024 = 1 then write('.'); end; if z = y then writeln(" (",i," steps)"); found := true; break; end; end; if found then nu := nu2 - nu1; mu := mu1 - mu2; if gcd(nu,q) = 1 then return (mod_inverse(nu,q)*mu) mod q; end; end; return -1; end; (*----------------------------------------------------------*) (* ** Hilfsfunktion fuer dlog_rho *) function lrho_step(p,g,x,y,q:integer; var nu,mu:integer): integer; var s: integer; begin s := y mod 3; if s = 0 then y := y*g mod p; inc(mu); elsif s = 1 then y := y**2 mod p; nu := 2*nu mod q; mu := 2*mu mod q; else y := y*x mod p; inc(nu); end; return y; end; (*----------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist0(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not necessarily prime"); end; return stack2array(st); end; (*----------------------------------------------------------*) (* ** Constructs an array of the prime factors of x, ** where multiple prime factors are listed repeatedly ** according to their multiplicity ** Uses rho_factorize and qs_factorize *) function factorlist(x: integer): array; var st, st1: stack; q, y, bound: integer; vec: array; count: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; if x < 2**32 then stack_push(st,x); else stack_push(st1,x); end; while not stack_empty(st1) do x := stack_pop(st1); if rab_primetest(x) then stack_push(st,x); else bound := bit_length(x); bound := 4*bound**2; y := rho_factorize(x,bound,0); count := 0; while (y <= 1 or y >= x) do if inc(count) > 2 then writeln("unable to factorize ",x); halt(-1); end; y := qs_factorize(x,0); end; stack_push(st1,x div y); stack_push(st1,y); end; end; vec := stack2array(st); return sort(vec); end; (*--------------------------------------------------------*) function primepowlist(x: integer): array; var i, p, p0, nu: integer; vec: array; st: stack; begin vec := factorlist(x); p0 := 0; nu := 1; for i := 0 to length(vec)-1 do p := vec[i]; if p = p0 then inc(nu); else if i > 0 then stack_push(st,(p0,nu)); end; p0 := p; nu := 1; end; end; stack_push(st,(p,nu)); return stack2array(st); end; (*--------------------------------------------------------*) (* ** Diskreter Logarithmus von x in (Z/p)* zur Basis g ** Benutzt Pohlig-Hellman Reduktion und ** Pollardsches Rho-Verfahren *) function dlog(p,g,x): integer; var pvec, mvec, logvec, lambda: array; i, len, k, A, X, t, q, n: integer; begin pvec := primepowlist(p-1); len := length(pvec); mvec := alloc(array,len); lambda := alloc(array,len); for i := 0 to len-1 do (q,n) := pvec[i]; mvec[i] := (p-1) div (q**n); lambda[i] := mod_inverse(mvec[i],q**n); end; logvec := alloc(array,len); write("working "); for i := len-1 to 0 by -1 do A := g**mvec[i] mod p; X := x**mvec[i] mod p; (q,n) := pvec[i]; if n = 1 then write(q," "); t := dlog_q(p,A,X,q); else write((q,n)," "); t := dlog_qn(p,A,X,q,n); end; logvec[i] := t; end; k := 0; for i := 0 to len-1 do k := k + logvec[i]*mvec[i]*lambda[i]; end; writeln(); return k mod (p-1); end; (*--------------------------------------------------------*) (* ** Hilfsfunktion fuer dlog ** Arbeitet in Untergruppe von (Z/p)* von Primzahlordnung q *) function dlog_q(p,g,x,q: integer): integer; const bound = 100; nbtrials = 20; var k, z: integer; begin if q <= bound then return dlog_naive(p,g,x,q); end; for k := 1 to nbtrials do z := dlog_rho(p,g,x,q); if z >= 0 then return z; end; end; writeln("random walk failed"); halt(-1); end; (*--------------------------------------------------------*) (* ** Hilfsfunktion fuer dlog_q ** Nur geeignet fuer kleine q *) function dlog_naive(p,g,x,q: integer): integer; var n, gn: integer; begin gn := 1; for n := 0 to q-1 do if gn = x then return n; end; gn := gn*g mod p; end; end; (*--------------------------------------------------------*) (* ** Hilfsfunktion fuer dlog ** Arbeitet in Untergruppe von (Z/p)* von Primzahlpotenzordnung q**n *) function dlog_qn(p,g,x,q,n: integer): integer; var g1,ginv,y,y0,t,tau,k: integer; begin ginv := mod_inverse(g,p); g1 := g**(q**(n-1)) mod p; t := 0; for k := 1 to n do y0 := x*(ginv**t mod p) mod p; y := y0**(q**(n-k)) mod p; tau := dlog_q(p,g1,y,q); t := t + tau*(q**(k-1)); end; return t; end; (*--------------------------------------------------------*) (* ** Liefert fuer eine ganze Zahl x einen Vektor, ** dessen Komponenten die Primfaktoren von x sind. ** Mehrfache Faktoren werden nur einmal aufgezaehlt. ** Funktioniert nur, wenn x hoechstens einen Primfaktor > 2**16 ** hat, der aber < 2**32 sein muss. *) function primefactors(x: integer): array; var i,p,p0: integer; vec: array; st: stack; begin vec := factorlist(x); p0 := 0; for i := 0 to length(vec)-1 do p := vec[i]; if p /= p0 then stack_push(st,p); p0 := p; end; end; return stack2array(st); end; (*--------------------------------------------------------------*) function primroot(p: integer): integer; var i, b, m: integer; found: boolean; qvec: array; begin qvec := primefactors(p-1); for b := 2 to p-1 do found := true; for i := 0 to length(qvec)-1 do m := (p-1) div qvec[i]; if b**m mod p = 1 then found := false; break; end; end; if found then return b; end; end; return 0; (* this case should not happen *) end; (*--------------------------------------------------------------*) chap22.ari000640 000766 000024 00000006525 12641720661 012774 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 22 ** Elliptische Kurven *) (*----------------------------------------------------------*) (* ** Globale Konstante; repraesentiert neutrales Element ** einer Elliptischen Kurve *) const Origin = (0,-1); end; (*----------------------------------------------------------*) (* ** Addition zweier Punkte P,Q auf der elliptischen Kurve ** mit affiner Gleichung Y**2 = X**3 + a*X + b ** ueber dem Koerper Z/p ** Der Parameter b wird implizit durch die Punkte P,Q gegeben *) function ecp_add(p,a: integer; P,Q: array[2]) : array[2]; external Origin: const; var m,m1,den,x,x1,x2,y,y1,y2: integer; begin if Q = Origin then return P; elsif P = Origin then return Q; elsif P = Q then return ecp_dup(p,a,P); end; (x1,y1) := P; (x2,y2) := Q; den := (x1 - x2) mod p; if den = 0 then return Origin; end; m1 := mod_inverse(den,p); m := (y1 - y2)*m1 mod p; x := (m*m - x1 - x2) mod p; y := (m * (x1 - x) - y1) mod p; return (x,y); end. (*----------------------------------------------------------*) (* ** Verdopplung des Punktes P auf der elliptischen Kurve ** mit affiner Gleichung Y**2 = X**3 + a*X + b *) function ecp_dup(p,a: integer; P: array[2]) : array[2]; external Origin: const; var m,m1,den,x,x1,y,y1: integer; begin if P = Origin then return P; end; (x1,y1) := P; m := (3 * x1*x1 + a) mod p; den := 2*y1 mod p; if den = 0 then return Origin; end; m1 := mod_inverse(den,p); m := m*m1 mod p; x := (m*m - 2*x1) mod p; y := (m * (x1 - x) - y1) mod p; return (x,y); end. (*----------------------------------------------------------*) (* ** Multiplikation eines Punktes P mit der ganzen Zahl s >= 0 *) function ecp_mult(p,a:integer; P:array[2]; s:integer): array[2]; external Origin: const; var i: integer; Q: array[2]; begin if (s = 0) or (P = Origin) then return Origin; end; Q := P; for i := bit_length(s)-2 to 0 by -1 do Q := ecp_dup(p,a,Q); if bit_test(s,i) then Q := ecp_add(p,a,Q,P); end; end; return Q; end. (*----------------------------------------------------------*) (* ** Bestimmt die Ordnung der elliptischen Kurve ** mit affiner Gleichung Y**2 = X**3 + a*X + b ** ueber dem Koerper Z/p ** Nur geeignet fuer kleine p (etwa < 10**6). *) function ecp_ord0(p,a,b: integer): integer; var x,N: integer; begin N := p + 1; for x := 0 to p-1 do N := N + jacobi(x*x*x + a*x + b,p); end; return N; end. (*----------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) chap23.ari000640 000766 000024 00000014443 12641720661 012773 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 23 ** Faktorisierung mit elliptischen Kurven *) (*----------------------------------------------------------*) (* ** Produkt aller Primzahlen B0 < p <= B1 ** und aller ganzen Zahlen isqrt(B0) < n <= isqrt(B1) ** Diese Funktion wird gebraucht von den Funktionen ** p1_factorize, pp1_factorize und ECfactorize *) function ppexpo(B0,B1: integer): integer; var x, m0, m1, i: integer; begin x := 1; m0 := max(2,isqrt(B0)+1); m1 := isqrt(B1); for i := m0 to m1 do x := x*i; end; if odd(B0) then inc(B0) end; for i := B0+1 to B1 by 2 do if prime32test(i) > 0 then x := x*i end; end; return x; end; (*----------------------------------------------------------*) (* ** Bestimmt die Ordnung der elliptischen Kurve ** mit affiner Gleichung Y**2 = X**3 + a*X + b ** ueber dem Koerper Z/p ** Nur geeignet fuer kleine p (etwa < 10**6). *) function ecp_ord0(p,a,b: integer): integer; var x,N: integer; begin N := p + 1; for x := 0 to p-1 do N := N + jacobi(x*x*x + a*x + b,p); end; return N; end; (*--------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*----------------------------------------------------------*) (* ** Globale Konstante; repraesentiert neutrales Element ** einer Elliptischen Kurve *) const Origin = (0,-1); end; (*----------------------------------------------------------*) (* ** Addition zweier Punkte P,Q auf der elliptischen Kurve ** mit affiner Gleichung Y**2 = X**3 + a*X + b ** ueber dem Koerper Z/p ** Der Parameter b wird implizit durch die Punkte P,Q gegeben *) function ecp_add(p,a: integer; P,Q: array[2]) : array[2]; external Origin: const; var m,m1,den,x,x1,x2,y,y1,y2: integer; begin if Q = Origin then return P; elsif P = Origin then return Q; elsif P = Q then return ecp_dup(p,a,P); end; (x1,y1) := P; (x2,y2) := Q; den := (x1 - x2) mod p; if den = 0 then return Origin; end; m1 := mod_inverse(den,p); m := (y1 - y2)*m1 mod p; x := (m*m - x1 - x2) mod p; y := (m * (x1 - x) - y1) mod p; return (x,y); end. (*----------------------------------------------------------*) (* ** Verdopplung des Punktes P auf der elliptischen Kurve ** mit affiner Gleichung Y**2 = X**3 + a*X + b *) function ecp_dup(p,a: integer; P: array[2]) : array[2]; external Origin: const; var m,m1,den,x,x1,y,y1: integer; begin if P = Origin then return P; end; (x1,y1) := P; m := (3 * x1*x1 + a) mod p; den := 2*y1 mod p; if den = 0 then return Origin; end; m1 := mod_inverse(den,p); m := m*m1 mod p; x := (m*m - 2*x1) mod p; y := (m * (x1 - x) - y1) mod p; return (x,y); end. (*----------------------------------------------------------*) (* ** Multiplikation eines Punktes P mit der ganzen Zahl s >= 0 *) function ecp_mult(p,a:integer; P:array[2]; s:integer): array[2]; external Origin: const; var i: integer; Q: array[2]; begin if (s = 0) or (P = Origin) then return Origin; end; Q := P; for i := bit_length(s)-2 to 0 by -1 do Q := ecp_dup(p,a,Q); if bit_test(s,i) then Q := ecp_add(p,a,Q,P); end; end; return Q; end. (*----------------------------------------------------------*) (* ** Multiplikation eines Punktes P mit s > 0 auf einer elliptischen ** Kurve mit affiner Gleichung Y**2 = X**3 + a*X + b ** ueber dem Ring Z/N ** Falls dabei ein Teiler d von N entdeckt wird, ist der ** Rueckgabewert (d, -1); sonst s*P = (x,y) mit 0 <= x,y < N. *) function ecN_mult(N,a:integer; P:array[2]; s:integer): array[2]; var x,x0,x1,y,y0,m1,mu,Fprime,d,k: integer; begin (x0,y0) := (x,y) := P; for k := bit_length(s)-2 to 0 by -1 do m1 := mod_inverse(2*y,N); if m1 = 0 then return (gcd(y,N),-1); end; Fprime := (3*x**2 + a) mod N; mu := (Fprime*m1) mod N; x1 := x; x := (mu**2 - 2*x) mod N; y := (-y - mu*(x - x1)) mod N; if bit_test(s,k) then m1 := mod_inverse(x-x0,N); if m1 = 0 then return (gcd(x-x0,N),-1); end; mu := m1*(y - y0) mod N; x := (mu**2 - x - x0) mod N; y := (-y0 - mu*(x - x0)) mod N; end; end; return (x,y); end; (*-----------------------------------------------------*) (* ** Faktorisierungs-Algorithmus mit elliptischen Kurven ** N ist die zu faktorisierende Zahl, bound eine Schranke ** fuer die Primfaktoren des Multiplikators und ** anz die Anzahl der Versuche. ** Rueckgabewert: Ein Teiler d von N oder 0, falls erfolglos *) function ECfactorize(N, bound, anz: integer): integer; const anz0 = 128; var k, a, x, y, d, B0, B1, s: integer; begin write("working "); for k := 1 to anz do write('.'); a := random(1000); x := random(N); y := 1; for B0 := 0 to bound-1 by anz0 do B1 := min(B0+anz0,bound); s := ppexpo(B0,B1); (x,y) := ecN_mult(N,a,(x,y),s); if y < 0 and x > 1 then writeln(); write("factor found after ",k," curves"); writeln(" with prime bound ",B1); return x; elsif y < 0 then break; end; end; end; return 0; end; (*-----------------------------------------------------*) (* ** Primzahl-Zertifikat fuer E19 = (10**19 - 1)/9 ** bzgl. des Primzahltest von Goldwasser/Kilian *) CertE19 := ((1111_11111_11111_11111, 1, 2, 378_33871_25171_70992, 91207_76099), (91207_76099, 1, 8, 74546_05774, 242989), (242989, 1, 0, 22704, 2437)). (*-----------------------------------------------------*) chap24.ari000640 000766 000024 00000003104 12641720661 012764 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 24 ** Quadratische Zahlkoerper *) (*----------------------------------------------------------*) function p2squaresum(p: integer): array[2]; var a, z: integer; xi: array[2]; begin a := 2; while jacobi(a,p) /= - 1 do inc(a); end; z := a**(p div 4) mod p; xi := gauss_gcd((z,1),(p,0)); return (abs(xi[0]),abs(xi[1])); end; (*----------------------------------------------------------*) (* ** Berechnet im Ring der ganzen Gauss'sche Zahlen ** fuer x,y in Z[i], (y /= 0), ** eine Zahl z in Z[i] mit x = z mod y und |z| < |y| *) function gauss_mod(x,y: array[2]): array[2]; var z0,z1,q0,q1,u0,u1,N,Nhalf: integer; begin N := y[0]*y[0] + y[1]*y[1]; Nhalf := N div 2; z0 := x[0]*y[0] + x[1]*y[1]; z1 := x[1]*y[0] - x[0]*y[1]; q0 := z0 div N; q1 := z1 div N; if (z0 mod N) > Nhalf then inc(q0) end; if (z1 mod N) > Nhalf then inc(q1) end; u0 := y[0]*q0 - y[1]*q1; u1 := y[0]*q1 + y[1]*q0; return (x[0]-u0, x[1]-u1); end; (*----------------------------------------------------------*) (* ** Groesster gemeinsamer Teiler im Ring der ganzen Gauss'schen Zahlen *) function gauss_gcd(x,y: array[2]): array[2]; var temp: array[2]; begin while y /= (0,0) do temp := y; y := gauss_mod(x,y) x := temp; end; return x; end; (*----------------------------------------------------------*) chap25.ari000640 000766 000024 00000006742 12641720661 013000 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 25 ** Der Vier-Quadrate-Satz von Lagrange *) (*----------------------------------------------------------*) (* ** Funktionen zum Satz von Lagrange fuer Primzahlen = 3 mod 4 ** ** Als Hilfsmittel einige Funktionen fuer ganzzahlige Quaternionen *) (*-----------------------------------------------------------*) (* ** Norm fuer ganzzahlige Quaternionen *) function h_norm(x: array[4]): integer; begin return x[0]**2 + x[1]**2 + x[2]**2 + x[3]**2; end; (*-------------------------------------------------------*) (* ** Konjugation fuer ganzzahlige Quaternionen *) function h_conj(x: array[4]): array[4]; begin return (x[0],-x[1],-x[2],-x[3]); end; (*-------------------------------------------------------*) (* ** Produkt der ganzzahligen Quaternionen x,y *) function h_mult(x,y: array[4]): array[4]; var z0,z1,z2,z3: integer; begin z0 := x[0]*y[0] - x[1]*y[1] - x[2]*y[2] - x[3]*y[3]; z1 := x[0]*y[1] + x[1]*y[0] + x[2]*y[3] - x[3]*y[2]; z2 := x[0]*y[2] - x[1]*y[3] + x[2]*y[0] + x[3]*y[1]; z3 := x[0]*y[3] + x[1]*y[2] - x[2]*y[1] + x[3]*y[0]; return (z0,z1,z2,z3); end; (*-------------------------------------------------------*) (* ** Die Argumente x,y sind ganzzahlige Quaternionen, y /= 0. ** Es wird Division mit Rest durchgefuehrt ** x = q*y + r ** Dabei ist q eine Hurwitz-Quaternion, der Rest r eine ganzzahlige ** Quaternion mit Norm(r) < Norm(y). ** Der Rest r wird zurueckgegeben. *) function h_mod(x,y: array[4]): array[4]; var N, Nhalf, i: integer; z, q, r, u: array[4]; begin N := h_norm(y); Nhalf := N div 2; z := h_mult(x,h_conj(y)); q := (z[0] div N, z[1] div N, z[2] div N, z[3] div N); r := (z[0] mod N, z[1] mod N, z[2] mod N, z[3] mod N); if even(N) and r = (Nhalf,Nhalf,Nhalf,Nhalf) then return (0,0,0,0); end; for i := 0 to 3 do if r[i] > Nhalf then inc(q[i]) end; end; u := h_mult(q,y); return (x[0]-u[0],x[1]-u[1],x[2]-u[2],x[3]-u[3]); end; (*-------------------------------------------------------*) (* ** Groesster gemeinsamer Teiler fuer ganzzahlige Quaternionen. ** Dabei wird im Ring der Hurwitz-Quaternionen gearbeitet, ** das Resultat ist aber immer eine ganzzahlige Quaternion. *) function h_gcd(x,y: array[4]): array[4]; var temp: array[4]; begin while y /= (0,0,0,0) do temp := y; y := h_mod(x,y); x := temp; end; return x; end; (*-------------------------------------------------------*) (* ** Das Argument p muss eine Primzahl = 3 mod 4 sein. ** Das Resultat ist ein Vektor aus 4 natuerlichen Zahlen, ** deren Quadratsumme gleich p ist. *) function p4squaresum(p: integer): array[4]; var x: array[2]; z: array[4]; begin x := fp_m1sqsum(p); z := h_gcd((p,0,0,0),(1,x[0],x[1],0)); return (abs(z[0]),abs(z[1]),abs(z[2]),abs(z[3])); end; (*-------------------------------------------------------*) (* ** Das Argument p muss eine Primzahl = 3 mod 4 sein ** Die Funktion berechnet (x,y), so dass ** x*x + y*y = - 1 mod p ** Wird von der Funktion p4squaresum benuetzt. *) function fp_m1sqsum(p: integer): array[2]; var x, y: integer; begin for x := 1 to p do if jacobi(-1-x*x,p) = 1 then break end; end; y := (-1-x*x)**((p+1) div 4) mod p; return (x,y); end; (*-------------------------------------------------------*) chap26.ari000640 001751 001751 00000005351 14137727213 014061 0ustar00forsterforster000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 26 ** Kettenbrueche *) (*----------------------------------------------------------*) (* ** Berechnet die ersten n Koeffizienten der Kettenbruch-Entwicklung ** von x und gibt sie als Array zurueck. ** Bemerkung: Da floating point Arithmetik nicht exakt ist, ** arbeitet auch real2cfrac nur mit begrenzter Genauigkeit. ** Zur Erhoehung der Genauigkeit sollte man vor Anwendung der Funktion ** die Anweisung ** set_floatprec(200). ** geben. Beispiel-Aufruf: real2cfrac(pi,20). *) (*------------------------------------------------------------------*) function real2cfrac(x: real; n: integer): array; var k, a: integer; y: real; vec: array[n] of integer; begin for k := 0 to n-1 do vec[k] := a := floor(x); y := x - a; if y = 0.0 then return vec[0..k] end; x := 1/y; end; return vec; end; (*-------------------------------------------------------------------*) (* ** Kettenbruch-Entwicklung von sqrt(N) ** Resultat ist ein Vektor (a0,a1,a2,...,an,2*a0), ** wobei a0 = [sqrt(N)] und (a1,a2,...,an,2*a0) die Periode ist. *) function sqrtn2cfrac(N: integer): array; var a, w, w2, q, q0, q1, m, m1: integer; st: stack; begin w := isqrt(N); q := N - w*w; if q = 0 then writeln(N," is a perfect square"); return {w}; end; w2 := 2*w; a := w; m := w; q0 := 1; stack_push(st,a); while a /= w2 do a := (m + w) div q; stack_push(st,a); m1 := a*q - m; q1 := q0 + a*(m - m1); m := m1; q0 := q; q := q1; end; return stack2array(st); end; (*--------------------------------------------------------------*) (* ** Berechnet den endlichen Kettenbruch einer rationalen Zahl u/v, ** die als Array (u,v) als Argument uebergeben wird. ** Beispiel-Aufruf: rat2cfrac((23,29)). *) function rat2cfrac(x: array[2] of integer): array; var u, v, temp: integer; st: stack; begin u := x[0]; v := x[1]; while v /= 0 do stack_push(st, u div v); temp := u mod v; u := v; v := temp; end; return stack2array(st); end; (*-------------------------------------------------------------------*) (* ** Umkehrfunktion von rat2cfrac *) function cfrac2rat(cf: array): array[2] of integer; var u,v,u0,v0,u1,v1,k: integer; begin v0 := 0; u0 := 1; v := 1; u := cf[0]; for k := 1 to length(cf)-1 do u1 := u; v1 := v; u := cf[k]*u + u0; v := cf[k]*v + v0; u0 := u1; v0 := v1; end; return (u,v); end; (*-------------------------------------------------------------------*) chap27.ari000640 000766 000024 00000004207 12641720662 012775 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 27 ** Die Pellsche Gleichung *) (*----------------------------------------------------------*) (* ** Berechnet die kleinste nicht-triviale Loesung von ** u*u - d*v*v = c, mit c aus {-4,+4,-1,+1} ** mittels Kettenbruch-Entwicklung von sqrt(d) ** und gibt (u,v,c) zurueck. ** Das Argument d muss eine positive ganze Zahl sein, ** die kein Quadrat ist. *) function pell4(d: integer): array[3]; var a, w, q, q0, q1, m, m1, sign: integer; u, u0, u1, v, v0, v1: integer; begin if d=5 then return (1,1,-4) end; w := isqrt(d); q := d - w*w; if q=0 then writeln("error: argument d is a perfect square"); halt(); end; q0 := 1; m := w; u0 := 1; u := m; v0 := 0; v := 1; sign := -1; while q /= 4 and q /= 1 do a := (m + w) div q; m1 := a*q - m; q1 := q0 + a*(m - m1); u1 := a*u + u0; v1 := a*v + v0; m := m1; q0 := q; q := q1; u0 := u; u := u1; v0 := v; v := v1; sign := -sign; end; return (u,v,sign*q); end; (*--------------------------------------------------------------*) (* ** Berechnet die kleinste nicht-triviale Loesung der ** Gleichung x**2 - d*y**2 = 1. ** Voraussetzung: d > 1 ganze Zahl, die kein Quadrat ist. *) function pell(d: integer): array[2]; var a, w, q, q0, q1, m, m1, sign: integer; u, u0, u1, v, v0, v1: integer; begin w := isqrt(d); q := d - w*w; if q=0 then writeln("error: argument d is a perfect square"); halt(); end; q0 := 1; m := w; u0 := 1; u := m; v0 := 0; v := 1; sign := -1; while q /= 1 do a := (m + w) div q; m1 := a*q - m; q1 := q0 + a*(m - m1); u1 := a*u + u0; v1 := a*v + v0; m := m1; q0 := q; q := q1; u0 := u; u := u1; v0 := v; v := v1; sign := -sign; end; if sign = 1 then return (u,v); else return (2*u*u+1,2*u*v); end; end; (*--------------------------------------------------------------*) chap28.ari000640 000766 000024 00000012621 12641720662 012775 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 28 ** Idealklassen quadratischer Zahlkoerper *) (*----------------------------------------------------------*) (* ** Routinen fuer Ideal-Klassen in imaginaer-quadratischen ** Zahlkoerpern Q(sqrt(-Delta)), Delta = 3 mod 4 oder Delta = 0 mod 4 ** ** Idealklassen werden dargestellt als Paare ganzer Zahlen. ** (a,b) steht fuer die Idealklasse, die durch das Gitter ** (a, (b + sqrt(-Delta))/2) repraesentiert wird. ** Es muss gelten b = Delta mod 2. ** Die zugehoerige quadratische Form ist a*x*x + b*x*y + c*y*y, ** wobei c := (b*b + Delta)/(4*a), (Division muss aufgehen). ** Ein Repraesentant (a,b) ist reduziert, falls ** abs(b) <= a <= c ** und b >= 0, falls abs(b) = a oder c = a *) (*-----------------------------------------------------------*) (* ** Reduziert das Ideal x ** im imaginaer-quadratischen Zahlkoerper Q(sqrt(-Delta)) *) function cl_reduce(x: array[2]; Delta: integer): array[2]; var a,b,c,d: integer; begin (a,b) := x; while true do b := b mod (2*a); if b > a then b := b - 2*a; end; c := (b*b + Delta) div (4*a); if a <= c then if a = c and b < 0 then b := -b; end; return (a,b); end; a := c; b := -b; end; end; (*-----------------------------------------------------------*) (* ** Erzeugt eine Idealklasse (p,b) mit Diskriminante Delta, ** wobei p die naechste ungerade Primzahl >= a ist, ** und gibt deren Reduktion zurueck. *) function cl_prim(a,Delta: integer): array[2]; var b,p: integer; begin p := next_prime(max(a,3)); while jacobi(-Delta,p) /= 1 do p := next_prime(p+2); end; b := gfp_sqrt(p,-Delta); if odd(Delta) /= odd(b) then b := p - b; end; return cl_reduce((p,b),Delta); end; (*-----------------------------------------------------------*) (* ** Ergibt die Einsklasse *) function cl_unit(Delta: integer): array[2]; begin if Delta mod 4 = 0 then return (1,0); else return (1,1); end; end; (*-----------------------------------------------------------*) (* ** Berechnet die inverse Klasse von x *) function cl_inverse(x: array[2]; Delta: integer): array[2]; begin x[1] := -x[1]; return cl_reduce(x,Delta); end; (*-----------------------------------------------------------*) (* ** Berechnet x*x in der Klassengruppe *) function cl_square(x: array[2]; Delta: integer): array[2]; var a,b,d,ac2,alfa,beta: integer; begin (a,b) := x; d := gcdx(a,b,alfa,beta); ac2 := (b*b + Delta) div 2; if d > 1 then a := a div d; ac2 := ac2 div d; end; return cl_reduce((a*a, b - beta*ac2),Delta); end; (*-----------------------------------------------------------*) (* ** Multiplikation von x1 mit x2 *) function cl_mult(x1,x2: array[2]; Delta: integer): array[2]; var a1,b1,a2,b2,a,b,d,ac2,u1,u2,v1,v2: integer; begin (a1,b1) := x1; (a2,b2) := x2; d := gcdx(a1,a2,u1,u2); if d = 1 then a := a1*a2; b := b2 + u2*a2*(b1-b2); else d := gcdx(d,(b1+b2) div 2,v1,v2); ac2 := (b2*b2 + Delta) div 2; if d > 1 then a1 := a1 div d; a2 := a2 div d; ac2 := ac2 div d; end; a := a1*a2; b := b2 + v1*u2*a2*(b1-b2) - v2*ac2; end; return cl_reduce((a,b),Delta); end; (*----------------------------------------------------------*) (* ** Berechnet x**n in der Klassengruppe (n >= 0). *) function cl_pow(x: array[2]; n,Delta: integer): array[2]; var z: array[2]; i: integer; begin if n = 0 then return cl_unit(Delta); end; z := x; for i := bit_length(n)-2 to 0 by -1 do z := cl_square(z,Delta); if bit_test(n,i) then z := cl_mult(z,x,Delta); end; end; return z; end; (*-----------------------------------------------------------*) (* ** Berechnet eine Liste aller reduzierten Idealklassen ** im imaginaer-quadratischen Zahlkoerper mit ** Diskriminante -Delta ** Nur effizient fuer kleines Delta (z.B. < 10**5) *) function classes(Delta: integer): array of array[2]; var st: stack; a,b,c,t,B: integer; begin B := isqrt(3*Delta) div 3; for b := (Delta mod 2) to B by 2 do t := (b**2 + Delta) div 4; for a := max(b,1) to isqrt(t) do if t mod a = 0 then c := t div a; if (a=b) or (a=c) or (b=0) then stack_push(st,(a,b)); else stack_push(st,(a,b)); stack_push(st,(a,-b)); end; end; end; end; return stack2array(st); end; (*------------------------------------------------------------------*) (* ** Calculates the class number of an imaginary quadratic ** number field with discriminant -Delta *) function classno(Delta: integer): integer; var h,a,b,c,B,t: integer; begin h := 0; B := isqrt(3*Delta) div 3; for b := (Delta mod 2) to B by 2 do t := (b**2 + Delta) div 4 for a := max(b,1) to isqrt(t) do if (t mod a = 0) then c := t div a; if (a=b) or (a=c) or (b=0) then inc(h); else inc(h,2); end; end; end; end; return h; end; (*------------------------------------------------------------------*) chap29.ari000640 000766 000024 00000021366 12641720662 013004 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 29 ** Faktorisierung mit der Klassengruppe *) (*----------------------------------------------------------*) (*----------------------------------------------------------*) (* ** Routinen fuer Ideal-Klassen in imaginaer-quadratischen ** Zahlkoerpern Q(sqrt(-Delta)), Delta = 3 mod 4 oder Delta = 0 mod 4 ** ** Idealklassen werden dargestellt als Paare ganzer Zahlen. ** (a,b) steht fuer die Idealklasse, die durch das Gitter ** (a, (b + sqrt(-Delta))/2) repraesentiert wird. ** Es muss gelten b = Delta mod 2. ** Die zugehoerige quadratische Form ist a*x*x + b*x*y + c*y*y, ** wobei c := (b*b + Delta)/(4*a), (Division muss aufgehen). ** Ein Repraesentant (a,b) ist reduziert, falls ** abs(b) <= a <= c ** und b >= 0, falls abs(b) = a oder c = a *) (*-----------------------------------------------------------*) (* ** Reduziert das Ideal x ** im imaginaer-quadratischen Zahlkoerper Q(sqrt(-Delta)) *) function cl_reduce(x: array[2]; Delta: integer): array[2]; var a,b,c,d: integer; begin (a,b) := x; while true do b := b mod (2*a); if b > a then b := b - 2*a; end; c := (b*b + Delta) div (4*a); if a <= c then if a = c and b < 0 then b := -b; end; return (a,b); end; a := c; b := -b; end; end; (*-----------------------------------------------------------*) (* ** Erzeugt eine Idealklasse (p,b) mit Diskriminante Delta, ** wobei p die naechste ungerade Primzahl >= a ist, ** und gibt deren Reduktion zurueck. *) function cl_prim(a,Delta: integer): array[2]; var b,p: integer; begin p := next_prime(max(a,3)); while jacobi(-Delta,p) /= 1 do p := next_prime(p+2); end; b := gfp_sqrt(p,-Delta); if odd(Delta) /= odd(b) then b := p - b; end; return cl_reduce((p,b),Delta); end; (*-----------------------------------------------------------*) (* ** Ergibt die Einsklasse *) function cl_unit(Delta: integer): array[2]; begin if Delta mod 4 = 0 then return (1,0); else return (1,1); end; end; (*-----------------------------------------------------------*) (* ** Berechnet die inverse Klasse von x *) function cl_inverse(x: array[2]; Delta: integer): array[2]; begin x[1] := -x[1]; return cl_reduce(x,Delta); end; (*-----------------------------------------------------------*) (* ** Berechnet x*x in der Klassengruppe *) function cl_square(x: array[2]; Delta: integer): array[2]; var a,b,d,ac2,alfa,beta: integer; begin (a,b) := x; d := gcdx(a,b,alfa,beta); ac2 := (b*b + Delta) div 2; if d > 1 then a := a div d; ac2 := ac2 div d; end; return cl_reduce((a*a, b - beta*ac2),Delta); end; (*-----------------------------------------------------------*) (* ** Multiplikation von x1 mit x2 *) function cl_mult(x1,x2: array[2]; Delta: integer): array[2]; var a1,b1,a2,b2,a,b,d,ac2,u1,u2,v1,v2: integer; begin (a1,b1) := x1; (a2,b2) := x2; d := gcdx(a1,a2,u1,u2); if d = 1 then a := a1*a2; b := b2 + u2*a2*(b1-b2); else d := gcdx(d,(b1+b2) div 2,v1,v2); ac2 := (b2*b2 + Delta) div 2; if d > 1 then a1 := a1 div d; a2 := a2 div d; ac2 := ac2 div d; end; a := a1*a2; b := b2 + v1*u2*a2*(b1-b2) - v2*ac2; end; return cl_reduce((a,b),Delta); end; (*----------------------------------------------------------*) (* ** Berechnet x**n in der Klassengruppe (n >= 0). *) function cl_pow(x: array[2]; n,Delta: integer): array[2]; var z: array[2]; i: integer; begin if n = 0 then return cl_unit(Delta); end; z := x; for i := bit_length(n)-2 to 0 by -1 do z := cl_square(z,Delta); if bit_test(n,i) then z := cl_mult(z,x,Delta); end; end; return z; end; (*-----------------------------------------------------------*) (* ** Initialisierungs-Funktion fuer cl_ranwalk *) function cl_rwinit(x: array[2]; bound: integer; var XX: array of array[2]; var KK: array; Delta: integer); var i: integer; begin for i := 0 to length(XX)-1 do KK[i] := 1 + random(bound); XX[i] := cl_pow(x,KK[i],Delta); end; end; (*-----------------------------------------------------------*) (* ** Random Walk in der von x erzeugten zyklischen Untergruppe ** Klassengruppe von Q(sqrt(-Delta)) mit hoechstens anz Schritten. ** anz sollte groesser als die Quadratwurzel der Ordnung ** von x sein. ** Falls erfolgreich, ist der Rueckgabewert ein Vielfaches ** der Ordnung von x, sonst 0. *) function cl_ranwalk(x: array[2]; anz,Delta: integer): integer; const p = 8191; s = 16; var XX: array[s] of array[2]; KK: array[s]; y, z: array[2]; i, nu, t1, t2: integer; begin cl_rwinit(x,anz*anz,XX,KK,Delta); z := y := x; t2 := t1 := 1; for i := 1 to anz do nu := (y[1]**2 mod p) mod s; inc(t1,KK[nu]); y := cl_mult(y,XX[nu],Delta); nu := (z[1]**2 mod p) mod s; inc(t2,KK[nu]); z := cl_mult(z,XX[nu],Delta); nu := (z[1]**2 mod p) mod s; inc(t2,KK[nu]); z := cl_mult(z,XX[nu],Delta); if y = z then return t2 - t1; end; end; return 0; end; (*-----------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) (* ** Produkt aller ungeraden Primzahlen B0 < p <= B1 ** und aller ungeraden ganzen Zahlen 2*isqrt(B0)+1 < n <= 2*isqrt(B1)+1 ** Funktioniert nur richtig, wenn n1 < 2**32 *) function poexpo(B0,B1: integer): integer; var x, m0, m1, i: integer; begin x := 1; m0 := isqrt(B0)+1; m1 := isqrt(B1); for i := m0 to m1 do x := x*(2*i + 1); end; if odd(B0) then inc(B0) end; for i := B0+1 to B1 by 2 do if prime32test(i) > 0 then x := x*i; end; end; return x; end; (*-----------------------------------------------------*) (* ** Faktorisiere N mit der Klassengruppen-Methode ** pbound: Obere Schranke fuer den Primteiler des Exponenten ** anz: Obere Schranke fuer die Anzahl der Versuche *) function CLfactorize(N,pbound,anz: integer): integer; var i, s, d: integer; begin if even(N) then return 2; end; s := (N + 2) mod 4; for i := 1 to anz do if s > 1 and N mod s = 0 then return s; end; d := CLfactorize0(s,N,pbound); if d > 1 then writeln("factor found using multiplier ",s); return d; end; inc(s,4); while factor16(s) do inc(s,4); end; end; return 0; end; (*-----------------------------------------------------------*) (* ** Versucht N mittels der Klassengruppe von Q(sqrt(-s*N)) zu ** faktorisieren. Es wird vorausgesetzt, dass s*N = 3 mod 4. *) function CLfactorize0(s,N,pbound: integer): integer; var i, anz, Delta, d, expo, t: integer; X, X0, X2: array[2]; begin Delta := s*N; expo := poexpo(1,pbound); i := anz := 1; while i <= anz do inc(i); write('.'); X0 := cl_prim(random(64000),Delta); X := cl_pow(X0,expo,Delta); X2 := cl_powtwoamb(X,Delta); if X2 /= cl_inverse(X2,Delta) then write(':'); t := cl_ranwalk(X2,pbound,Delta); if t > 0 then while even(t) do t := t div 2; end; X := cl_pow(X,t,Delta); X2 := cl_powtwoamb(X,Delta); end; end; if X2 = cl_inverse(X2,Delta) then anz := 8; write('!'); d := 2*X2[0] - X2[1]; d := gcd(N,d); if d > 1 then writeln(); return d; end; end; end; return 0; end; (*-----------------------------------------------------------*) (* ** Sucht durch sukzessives Quadrieren von X eine ambige Klasse. ** Falls erfolgreich, wird die ambige Klasse zurueckgegeben. ** Andernfalls wird die ** zuletzt berechnete Potenz von X zurueckgegeben. *) function cl_powtwoamb(X: array[2]; Delta: integer): array[2]; var i: integer; X2, Eins: array[2]; begin Eins := cl_unit(Delta); for i := 1 to bit_length(Delta) div 2 do X2 := cl_square(X,Delta); if X2 = Eins then return X; end; X := X2; end; return X; end; (*-----------------------------------------------------------*) chap30.ari000640 000766 000024 00000011235 12641720662 012766 0ustar00ottostaff000000 000000 (************************************************************) (* ** Otto Forster: Algorithmische Zahlentheorie, 2. Aufl. ** Springer Spektrum 2015, ISBN 978-3-658-06539-3 ** ** ARIBAS Beispiel-Code zu Paragraph 30 ** Der AKS-Primzahltest *) (*----------------------------------------------------------*) (* ** Erstellt ein Array von Faktoren von x ** Alle Elemente, bis auf moeglicherweise das letzte, sind ** Primfaktoren < 2**16. Ist das letzte Element < 2**32, ** so ist es ebenfalls prim *) function factorlist(x: integer): array; var st: stack; q: integer; begin q := 2; while q := factor16(x,q) do stack_push(st,q); x := x div q; end; stack_push(st,x); if x > 2**32 then writeln("last factor not neccessarily prime"); end; return stack2array(st); end; (*--------------------------------------------------------------*) (* ** Liefert fuer eine ganze Zahl x einen Vektor, ** dessen Komponenten die Primfaktoren von x sind. ** Mehrfache Faktoren werden nur einmal aufgezaehlt. ** Funktioniert nur, wenn x hoechstens einen Primfaktor > 2**16 ** hat, der aber < 2**32 sein muss. *) function primefactors(x: integer): array; var i,p,p0: integer; vec: array; st: stack; begin vec := factorlist(x); p0 := 0; for i := 0 to length(vec)-1 do p := vec[i]; if p /= p0 then stack_push(st,p); p0 := p; end; end; return stack2array(st); end; (*--------------------------------------------------------------*) (* ** Bestimmt fuer eine Primzahl r die Ordnung eines ** Elements x in (Z/r)*. *) function Zrstar_order(r,x: integer): integer; var s, p, k, z: integer; pvec: array; begin if x mod r = 0 then return 0; end; s := r-1; pvec := primefactors(s); for k := 0 to length(pvec)-1 do p := pvec[k]; while s mod p = 0 do s := s div p; end; z := x**s mod r; while z /= 1 do z := z**p mod r; s := s*p; end; end; return s; end; (*--------------------------------------------------------------*) (* ** Bestimmt eine geeignete Primzahl r fuer den ** AKS-Primzahltest der Zahl N *) function AKS_findr(N: integer): integer; var r, blen, bl2, bl5: integer; begin blen := bit_length(N); bl2 := blen**2; bl5 := blen**5; r := next_prime(bl2); while r < bl5 do if N mod r = 0 then return -1; elsif Zrstar_order(r,N) >= bl2 then return r; else r := next_prime(r+2); end; end; return 0; end; (*--------------------------------------------------------------*) (* ** Multiplikation zweier Polynome F,G ueber dem Ring Z/N ** Ein Polynom F(X) = sum( a_k*X**k, 0 <= k <= n), a_n /= 0 ** wird repraesentiert durch das Array (a_0,a_1,...,a_n). *) function ZnXmult(N: integer; F,G: array): array; var n,m,i,i0,i1,k,x: integer; R: array; begin n := length(F)-1; m := length(G)-1; if n < 0 or m < 0 then return (); end; R := alloc(array,n+m+1); for k := 0 to n+m do x := 0; i0 := max(0,k-m); i1 := min(n,k); for i := i0 to i1 do x := x + F[i]*G[k-i]; end; R[k] := x mod N; end; return arr_trim(R); end; (*--------------------------------------------------------------*) (* ** Entfernt fuehrende Nullen aus dem Array F ** Wird benutzt von ZnX_mult *) function arr_trim(F: array): array; var d: integer; begin d := length(F)-1; if d < 0 or F[d] /= 0 then return F; end; dec(d); while d >= 0 and F[d] = 0 do dec(d); end; return F[0..d]; end; (*--------------------------------------------------------------*) (* ** Entscheidender Test beim AKS-Prtimzahltes fuer die Zahl N ** r ist eine Primzahl, wie sie von AKS_findr(N) konstruiert wird. ** AKS_check(N,r,a) muss true ergeben fuer alle ganzen Zahlen ** a mit 1 <= a <= sqrt(r)*log_2(N). ** (log_2 ist Logarithmus zur Basis 2) *) function AKS_check(N,r,a: integer): boolean; var k, i, len, s: integer; F, F1, G: array; begin F := (a,1); for k := bit_length(N)-2 to 0 by -1 do F := ZnXmult(N,F,F); write('.'); if length(F) > r then F1 := F[r..]; F := (F[0..r-1] + F1) mod N; F := arr_trim(F); end; if bit_test(N,k) then F := ZnXmult(N,F,(a,1)); if length(F) = r+1 then F[0] := (F[0] + F[r]) mod N; F := arr_trim(F[0..r-1]); end; end; end; s := N mod r; G := alloc(array,s+1,0); G[0] := a mod N; G[s] := 1; return (F = G); end; (*--------------------------------------------------------------*)