Flint2-0.1.0.5: Haskell bindings for the flint library for number theory
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Number.Flint.Groups.Qfb

Description

 
Synopsis

Binary quadratic forms

data Qfb Source #

Constructors

Qfb !(ForeignPtr CQfb) 

Instances

Instances details
Show Qfb Source # 
Instance details

Defined in Data.Number.Flint.Groups.Qfb.Instances

Methods

showsPrec :: Int -> Qfb -> ShowS #

show :: Qfb -> String #

showList :: [Qfb] -> ShowS #

data CQfb Source #

Constructors

CQfb (Ptr CFmpz) (Ptr CFmpz) (Ptr CFmpz) 

Instances

Instances details
Storable CQfb Source # 
Instance details

Defined in Data.Number.Flint.Groups.Qfb.FFI

Methods

sizeOf :: CQfb -> Int #

alignment :: CQfb -> Int #

peekElemOff :: Ptr CQfb -> Int -> IO CQfb #

pokeElemOff :: Ptr CQfb -> Int -> CQfb -> IO () #

peekByteOff :: Ptr b -> Int -> IO CQfb #

pokeByteOff :: Ptr b -> Int -> CQfb -> IO () #

peek :: Ptr CQfb -> IO CQfb #

poke :: Ptr CQfb -> CQfb -> IO () #

newQfb :: Fmpz -> Fmpz -> Fmpz -> IO Qfb Source #

Create a Qfb.

withQfb :: Qfb -> (Ptr CQfb -> IO a) -> IO (Qfb, a) Source #

Use Qfb in f.

withNewQfb :: Fmpz -> Fmpz -> Fmpz -> (Ptr CQfb -> IO a) -> IO (Qfb, a) Source #

Apply f to new Qfb.

Memory management

qfb_init :: Ptr CQfb -> IO () Source #

qfb_init q

Initialise a code{qfb_t} \(q\) for use.

qfb_clear :: Ptr CQfb -> IO () Source #

qfb_clear q

Clear a code{qfb_t} after use. This releases any memory allocated for \(q\) back to flint.

qfb_array_clear :: Ptr (Ptr CQfb) -> CLong -> IO () Source #

qfb_array_clear forms num

Clean up an array of code{qfb} structs allocated by a qfb function. The parameter code{num} must be set to the length of the array.

Hash table

qfb_hash_init :: CLong -> IO (Ptr (Ptr CQfbHash)) Source #

qfb_hash_init depth

Initialises a hash table of size \(2^{depth}\).

qfb_hash_clear :: Ptr (Ptr CQfbHash) -> CLong -> IO () Source #

qfb_hash_clear qhash depth

Frees all memory used by a hash table of size \(2^{depth}\).

qfb_hash_insert :: Ptr (Ptr CQfbHash) -> Ptr CQfb -> Ptr CQfb -> CLong -> CLong -> IO () Source #

qfb_hash_insert qhash q q2 iter depth

Insert the binary quadratic form code{q} into the given hash table of size \(2^{depth}\) in the field code{q} of the hash structure. Also store the second binary quadratic form code{q2} (if not code{NULL}) in the similarly named field and code{iter} in the similarly named field of the hash structure.

qfb_hash_find :: Ptr (Ptr CQfbHash) -> Ptr CQfb -> CLong -> IO CLong Source #

qfb_hash_find qhash q depth

Search for the given binary quadratic form or its inverse in the given hash table of size \(2^{depth}\). If it is found, return the index in the table (which is an array of code{qfb_hash_t} structs, otherwise return code{-1L}.

Basic manipulation

qfb_set :: Ptr CQfb -> Ptr CQfb -> IO () Source #

qfb_set f g

Set the binary quadratic form \(f\) to be equal to \(g\).

Comparison

qfb_equal :: Ptr CQfb -> Ptr CQfb -> IO CInt Source #

qfb_equal f g

Returns \(1\) if \(f\) and \(g\) are identical binary quadratic forms, otherwise returns \(0\).

Input/output

qfb_print :: Ptr CQfb -> IO () Source #

qfb_print q

Print a binary quadratic form \(q\) in the format \((a, b, c)\) where \(a\), \(b\), \(c\) are the entries of \(q\).

Computing with forms

qfb_discriminant :: Ptr CFmpz -> Ptr CQfb -> IO () Source #

qfb_discriminant D f

Set \(D\) to the discriminant of the binary quadratic form \(f\), i.e. to \(b^2 - 4ac\), where \(f = (a, b, c)\).

qfb_reduce :: Ptr CQfb -> Ptr CQfb -> Ptr CFmpz -> IO () Source #

qfb_reduce r f D

Set \(r\) to the reduced form equivalent to the binary quadratic form \(f\) of discriminant \(D\).

qfb_is_reduced :: Ptr CQfb -> IO CInt Source #

qfb_is_reduced r

Returns \(1\) if \(q\) is a reduced binary quadratic form. Otherwise returns \(1\).

qfb_reduced_forms :: Ptr (Ptr CQfb) -> CLong -> IO CLong Source #

qfb_reduced_forms forms d

Given a discriminant \(d\) (negative for negative definite forms), compute all the reduced binary quadratic forms of that discriminant. The function allocates space for these and returns it in the variable code{forms} (the user is responsible for cleaning this up by a single call to code{qfb_array_clear} on code{forms}, after use. The function returns the number of forms generated (the form class number). The forms are stored in an array of code{qfb} structs, which contain fields code{a, b, c} corresponding to forms \((a, b, c)\).

qfb_reduced_forms_large :: Ptr (Ptr CQfb) -> CLong -> IO CLong Source #

qfb_reduced_forms_large forms d

As for qfb_reduced_forms. However, for small \(|d|\) it requires fewer primes to be computed at a small cost in speed. It is called automatically by code{qfb_reduced_forms} for large \(|d|\) so that flint_primes is not exhausted.

qfb_nucomp :: Ptr CQfb -> Ptr CQfb -> Ptr CQfb -> Ptr CFmpz -> Ptr CFmpz -> IO () Source #

qfb_nucomp r f g D L

Shanks' NUCOMP as described in~citep{JacvdP}

% Computational aspects of NUCOMP", Michael J. Jacobson Jr., % Alfred J. van der Poorten, ANTS 2002, LNCS 2369, pp. 120--133.

Computes the near reduced composition of forms \(f\) and \(g\) given \(L = \lfloor |D|^{1/4} \rfloor\) where \(D\) is the common discriminant of \(f\) and \(g\). The result is returned in \(r\).

We require that that \(f\) is a primitive form.

qfb_nudupl :: Ptr CQfb -> Ptr CQfb -> Ptr CFmpz -> Ptr CFmpz -> IO () Source #

qfb_nudupl r f D L

As for code{nucomp} except that the form \(f\) is composed with itself. We require that that \(f\) is a primitive form.

qfb_pow_ui :: Ptr CQfb -> Ptr CQfb -> Ptr CFmpz -> CULong -> IO () Source #

qfb_pow_ui r f D exp

Compute the near reduced form \(r\) which is the result of composing the principal form (identity) with \(f\) code{exp} times.

We require \(D\) to be set to the discriminant of \(f\) and that \(f\) is a primitive form.

qfb_pow :: Ptr CQfb -> Ptr CQfb -> Ptr CFmpz -> Ptr CFmpz -> IO () Source #

qfb_pow r f D exp

As per code{qfb_pow_ui}.

qfb_inverse :: Ptr CQfb -> Ptr CQfb -> IO () Source #

qfb_inverse r f

Set \(r\) to the inverse of the binary quadratic form \(f\).

qfb_is_principal_form :: Ptr CQfb -> Ptr CFmpz -> IO CInt Source #

qfb_is_principal_form f D

Return \(1\) if \(f\) is the reduced principal form of discriminant \(D\), i.e. the identity in the form class group.

qfb_principal_form :: Ptr CQfb -> Ptr CFmpz -> IO () Source #

qfb_principal_form f D

Set \(f\) to the principal form of discriminant \(D\), i.e. the identity in the form class group.

qfb_is_primitive :: Ptr CQfb -> IO CInt Source #

qfb_is_primitive f

Return \(1\) if \(f\) is primitive, i.e. the greatest common divisor of its three coefficients is \(1\). Otherwise the function returns \(0\).

qfb_prime_form :: Ptr CQfb -> Ptr CFmpz -> Ptr CFmpz -> IO () Source #

qfb_prime_form r D p

Sets \(r\) to the unique prime \((p, b, c)\) of discriminant \(D\), i.e. with \(0 < b \leq p\). We require that \(p\) is a prime.

qfb_exponent_element :: Ptr CFmpz -> Ptr CQfb -> Ptr CFmpz -> CULong -> CULong -> IO CInt Source #

qfb_exponent_element exponent f n B1 B2_sqrt

Find the exponent of the element \(f\) in the form class group of forms of discriminant \(n\), doing a stage \(1\) with primes up to at least code{B1} and a stage \(2\) for a single large prime up to at least the square of code{B2}. If the function fails to find the exponent it returns \(0\), otherwise the function returns \(1\) and code{exponent} is set to the exponent of \(f\), i.e. the minimum power of \(f\) which gives the identity.

It is assumed that the form \(f\) is reduced. We require that code{iters} is a power of \(2\) and that code{iters} >= 1024.

The function performs a stage \(2\) which stores up to \(4\times\) code{iters} binary quadratic forms, and \(12\times\) code{iters} additional limbs of data in a hash table, where code{iters} is the square root of code{B2}.

qfb_exponent :: Ptr CFmpz -> Ptr CFmpz -> CULong -> CULong -> CLong -> IO CInt Source #

qfb_exponent exponent n B1 B2_sqrt c

Compute the exponent of the class group of discriminant \(n\), doing a stage \(1\) with primes up to at least code{B1} and a stage \(2\) for a single large prime up to at least the square of code{B2_sqrt}, and with probability at least \(1 - 2^{-c}\). If the prime limits are exhausted without finding the exponent, the function returns \(0\), otherwise it returns \(1\) and code{exponent} is set to the computed exponent, i.e. the minimum power which every element of the class group has to be raised to give the identity.

The function performs a stage \(2\) which stores up to \(4\times\) code{iters} binary quadratic forms, and \(12\times\) code{iters} additional limbs of data in a hash table, where code{iters} is the square root of code{B2}.

We use algorithm 8.1 of~citep{SuthThesis}

% "Order Computations in Generic Groups", Andrew Sutherland, % MIT Thesis 2007. % http://groups.csail.mit.edu/cis/theses/sutherland-phd.pdf

qfb_exponent_grh :: Ptr CFmpz -> Ptr CFmpz -> CULong -> CULong -> CULong -> IO CInt Source #

qfb_exponent_grh exponent n iters B1 B2_sqrt

As per code{qfb_exponent} except that the bound code{c} is automatically generated such that the exponent it guaranteed to be correct, if found, assuming the GRH, namely that the class group is generated by primes less than \(6\log^2(|n|)\) as per~citep{BuchDull1992}

% "Distributed Class Group Computation", Johannes Buchmann, Stephan % D"{u}llman, Informatik 1 (1992), pp. 69--79.