-- | 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