-- | Test the Class Number algorithm, and its components, using classical computation
module Algorithms.CL.Test where
import QuipperLib.FPReal
import Algorithms.CL.Auxiliary
import Algorithms.CL.Types
import Algorithms.CL.RegulatorClassical
import Algorithms.CL.CL
import Data.Ratio
import Data.List
-- | Classical period finding (just compare the \"next\" ideal to /O/ and see if
-- it is the same). Takes in the /O/ ideal with appropriate Δ, and returns
-- the circle length (sum δ(I)) and the list of ideals in the first iteration.
periodOfIdeals :: (IdDist->IdDist) -> IdDist -> (CLReal, [IdDist])
periodOfIdeals func o = (delta $ last list, list)
where
list = takePeriod False (iterate (\i -> func i) o)
takePeriod :: Bool -> [IdDist] -> [IdDist]
takePeriod got_first_o [] = undefined -- not reached
takePeriod got_first_o (x:xs) =
if (fst x == fst o) then
if (got_first_o) then
[x] -- Have two O's, stop iterating here
else
x : takePeriod True xs -- This was first O, mark as such
else
x : takePeriod got_first_o xs
-- | Show period string for a given Δ.
showPeriodForBigD :: CLIntP -> String
showPeriodForBigD bigD =
let (delta, ideals) = periodOfIdeals rho_d $ (unit_ideal bigD, 0)
in "For bigD=" ++ (show bigD) ++ " the period has "
++ (show $ (length ideals) - 1) ++ " ideals and sum delta is "
++ (show delta)
-- | Show the period for the first /n/ valid Δ's.
showPeriodForManyDs :: Int -> IO()
showPeriodForManyDs n = do
putStrLn $ unlines $ map (\bigD -> showPeriodForBigD bigD) $ sort $ take n all_bigDs
-- | Show period string and the list of ideals for a given Δ.
showPeriodForSomeBigD :: CLIntP -> IO()
showPeriodForSomeBigD bigD = do
putStrLn $ showPeriodForBigD bigD
putStrLn "Fwd rho_d:"
putStrLn $ unlines $ map printIdeal ideals
putStrLn "Inv rho_d:"
putStrLn $ unlines $ map printIdeal invideals
where
(delta, ideals) = periodOfIdeals rho_d $ (unit_ideal bigD, 0)
(invdelta, invideals) = periodOfIdeals rhoInv_d $ (unit_ideal bigD, 0)
printIdeal ideal =
(show ideal)
++ " Reduced: "
++ if (is_reduced $ fst ideal) then "true" else "false"
-- | Show a list of valid Δ's.
showBigDs :: Int -> IO()
showBigDs n = do
putStrLn $ show $ take n all_bigDs
-- | Explicitly compute first few ideals for some Δ.
firstFew :: IO()
firstFew = do
putStrLn $ "O :" ++ show j_0
putStrLn $ "j1/2:" ++ show j_05
putStrLn $ "j1 :" ++ show j_1
where
bigD = 17
j_0 = (unit_ideal bigD, 0)
j_05 = rho_d j_0
j_1 = rho_d j_05
-- | Perform an operation on all ideal pairs that are generated by Δ.
opAllIdeals :: (IdDist -> IdDist -> IdDist) -> String -> CLIntP -> IO()
opAllIdeals op opString bigD = do
putStrLn $ unlines $ [ doOp i j | i <- ideals, j <- ideals ]
where
(delta, ideals_with_o) = periodOfIdeals rho_d $ (unit_ideal bigD, 0)
ideals = init ideals_with_o
doOp i j = "(" ++ (show i) ++ ")" ++ opString ++ "(" ++ (show j) ++ ") = "
++ (show (i_op_j))
++ " Reduced:"
++ (if (is_reduced $ fst i_op_j) then "true" else "false")
-- ++ " rho_d of:" ++ (show $ rho_d i_op_j)
where i_op_j = i `op` j
-- | The the product of all pairs of ideals for a given Δ.
dotAllIdeals :: CLIntP -> IO()
dotAllIdeals bigD = opAllIdeals dot "." bigD
-- | Take the star product of all pairs of ideals for a given Δ.
starAllIdeals :: CLIntP -> IO()
starAllIdeals bigD = opAllIdeals star "*" bigD
-- | Test the 'boundedWhile' functionality.
testBoundedWhile :: (Show int, Integral int) => int -> int -> IO()
testBoundedWhile bound start = do
putStrLn $ show $
boundedWhile (\k -> k > 0) bound
(\k -> k-1) start
-- | Run classical tests for Class Number algorithm.
main :: IO()
main = do
-- testBoundedWhile 10 5
-- putStrLn $ "a=23, b=-41, bigD=28, tau =" ++ show (tau (-41) 23 28)
-- putStrLn $ "a=23, b=-41, bigD=28, itau=" ++ show (itau (-41) 23 28)
-- putStrLn $ unlines $ testTauForDelta 28 tau
-- firstFew
-- showDs 50
-- showPeriodForManyBigDs 400
-- showPeriodForSomeBigD 28
-- dotAllIdeals 28
starAllIdeals 28
-- putStrLn $ show $ rho_d $ (Ideal 28 1 1 9 8, 0)
-- putStrLn $ show $ take 100 all_small_ds
-- putStrLn $ show $ sort $ take 100 all_bigDs
-- For bigD=2524 the period has 48 ideals and sum delta is 41.3199021281136
-- putStrLn $ show $ continuedList 649 200
-- putStrLn $ show $ convergents $ continuedList 649 200
-- | Test the primes code.
testPrimes :: IO ()
testPrimes = do
-- putStrLn $ show $ jacobiSymbol 1001 9907
-- putStrLn $ show $ jacobiSymbol 14 7
putStrLn $ show $ primesTo 8000