ruff 0.3.2.1 → 0.4
raw patch · 10 files changed
+442/−228 lines, 10 filesdep +safedep +strict
Dependencies added: safe, strict
Files
- Fractal/RUFF/Mandelbrot/Address.hs +244/−160
- Fractal/RUFF/Mandelbrot/Atom.hs +17/−17
- Fractal/RUFF/Mandelbrot/Image.hs +7/−7
- Fractal/RUFF/Mandelbrot/Iterate.hs +1/−1
- Fractal/RUFF/Mandelbrot/Nucleus.hs +8/−9
- Fractal/RUFF/Mandelbrot/Ray.hs +4/−4
- Fractal/RUFF/Types/Complex.hs +1/−1
- Fractal/RUFF/Types/Ratio.hs +152/−0
- Fractal/RUFF/Types/Tuple.hs +0/−23
- ruff.cabal +8/−6
Fractal/RUFF/Mandelbrot/Address.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-} {- | Module : Fractal.RUFF.Mandelbrot.Address-Copyright : (c) Claude Heiland-Allen 2010-2011+Copyright : (c) Claude Heiland-Allen 2010,2011,2015 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable @@ -13,13 +14,16 @@ when extended to angled internal addresses they distinguish hyperbolic components in a concise and meaningful way. -The algorithms are mostly based on Dierk Schleicher's paper+The algorithms are mostly based on Dierk Schleicher's papers /Internal Addresses Of The Mandelbrot Set And Galois Groups Of Polynomials (version of February 5, 2008)/-<http://arxiv.org/abs/math/9411238v2>.+<http://arxiv.org/abs/math/9411238v2> and+/Rational parameter rays of the Mandelbrot set (version of August 11, 1998)/+<http://arxiv.org/abs/math/9711213v2>. -} module Fractal.RUFF.Mandelbrot.Address- ( Angle, double, wrap, prettyAngle, prettyAngles+ ( Angle, tune, prettyAngle, prettyAngles, angles+ , BinAngle, binary, unbinary, btune, prettyBinAngle, parseBinAngle, bperiod, bpreperiod, bangles , Knead(..), kneadChar , Kneading(..), prettyKneading, kneading, period, unwrap, associated, upper, lower , InternalAddress(..), prettyInternalAddress, internalAddress, internalFromList, internalToList@@ -28,17 +32,93 @@ , parseAngle, parseAngles, parseKnead, parseKneading, parseInternalAddress, parseAngledInternalAddress ) where +import Prelude hiding (Rational)+import Safe (headNote) import Data.Data (Data()) import Data.Typeable (Typeable()) import Control.Monad (guard) import Control.Monad.Identity (Identity()) import Data.Char (digitToInt)-import Data.Bits (testBit)-import Data.List (genericDrop, genericIndex, genericLength, genericReplicate, genericSplitAt, genericTake, foldl')-import Data.Maybe (isJust, listToMaybe)-import Data.Ratio ((%), numerator, denominator)-import Text.Parsec (ParsecT(), choice, digit, eof, many, many1, runP, sepEndBy, string, try)+import Data.Bits (shiftL, shiftR, (.&.), (.|.))+import Data.List (elemIndex, foldl', sort, sortBy, nub)+import Data.Maybe (mapMaybe)+import Data.Ord (comparing)+import Data.Strict.Tuple (Pair((:!:)))+import Fractal.RUFF.Types.Ratio (Q(..), Rational)+import Text.Parsec (ParsecT(), choice, digit, eof, many, many1, runParser, sepEndBy, string, try) +ceiling' :: (Q r, Z r ~ Integer) => r -> Int -> Integer+ceiling' x y = ((numerator x `shiftL` y) - numerator x + denominator x - 1) `div` denominator x++floor' :: (Q r, Z r ~ Integer) => r -> Int -> Integer+floor' x y = ((numerator x `shiftL` y) - numerator x) `div` denominator x++-- | All external angles landing at the same location as the given external angle.+angles :: Angle -> [Angle]+angles = map unbinary . bangles . binary++-- | All external angles landing at the same location as the given external angle (binary angle variant).+bangles :: BinAngle -> [BinAngle]+bangles = rays+ where+ periodic :: Int -> BinAngle -> Maybe BinAngle+ periodic = preperiodic 0+ preperiodic :: Int -> Int -> BinAngle -> Maybe BinAngle+ preperiodic preperiod' period' (pre, per) =+ let (pre', per') = splitAt preperiod' (pre ++ cycle per)+ in check (pre', take period' per')+ where+ check t@(_, p)+ | null p = Nothing+ | binary (unbinary t) == t = Just t+ | otherwise = Nothing+ rays :: BinAngle -> [BinAngle]+ rays t+ | pp == 0 = case fmap (map binary . sort . (\(a,b) -> [a,b])) . (externalAngles =<<) . angledInternalAddress . unbinary $ t of+ Just xs -> xs+ Nothing -> []+ | pp > 0 = case kneading (unbinary t) of+ PrePeriodic _ kper -> case p `divMod` length kper of+ (n, m)+ | m /= 0 -> error $ "rays Preperiodic: " ++ show (p, length kper, n, m)+ | n > 1 -> headNote "rays PrePeriodic" . dropWhile ((n /=) . length) . iterate (rays' n pp p) $ [t]+ | n == 1 -> rays'' pp p t+ | otherwise -> error $ "rays " ++ show pp ++ " " ++ show p ++ " " ++ show n+ k -> error $ "rays " ++ show pp ++ " " ++ show p ++ " " ++ show k+ | otherwise = error $ "rays " ++ show pp ++ " " ++ show p ++ " " ++ show t+ where+ pp = bpreperiod t+ p = bperiod t+ rays' :: Int -> Int -> Int -> [BinAngle] -> [BinAngle]+ rays' n pp p ts+ | not (null ts)+ = sortBy (comparing unbinary)+ . take (n `min` (length ts + 2))+ . nub+ . mapMaybe (preperiodic pp p)+ . concat+ . mapMaybe+ ( fmap (map binary . (\(a,b) -> [a,b]))+ . (externalAngles =<<)+ . (angledInternalAddress =<<)+ . fmap unbinary+ )+ $ [ periodic m t | m <- [2 * pp + p ..], t <- ts ]+ | otherwise = error "rays' null ts"+ rays'' :: Int -> Int -> BinAngle -> [BinAngle]+ rays'' pp p t+ = sortBy (comparing unbinary)+ . nub+ . mapMaybe (fmap (binary . unbinary) . preperiodic pp p)+ . concat+ . mapMaybe+ ( fmap (map binary . (\(a,b) -> [a,b]))+ . (externalAngles =<<)+ . (angledInternalAddress =<<)+ . fmap unbinary+ )+ $ [ periodic m t | m <- [2 * (pp + p) .. 3 * (pp + p)] ]+ -- | Angle as a fraction of a turn, usually in [0, 1). type Angle = Rational @@ -52,26 +132,46 @@ prettyAngles [a] = show (numerator a) ++ "/" ++ show (denominator a) prettyAngles (a:as) = show (numerator a) ++ "/" ++ show (denominator a) ++ " " ++ prettyAngles as --- | Wrap an angle into [0, 1).-wrap :: Angle -> Angle-wrap a- | f < 0 = 1 + f- | otherwise = f+-- | Binary representation of a (pre-)periodic angle.+type BinAngle = ([Bool], [Bool])++-- | Convert to human readable form.+prettyBinAngle :: BinAngle -> String+prettyBinAngle (pre, per) = "." ++ map b pre ++ "(" ++ map b per ++ ")" where- (_, f) = properFraction a :: (Integer, Angle)+ b False = '0'+ b True = '1' --- | Angle doubling map.-double :: Angle -> Angle-double a = wrap (2 * a)+-- | Convert from human readable form.+parseBinAngle :: String -> Maybe BinAngle+parseBinAngle s =+ case s of+ '.':s1 -> case break ('('==) s1 of+ (pre, '(':s2) -> case break (')'==) s2 of+ (per, ")") -> case all (`elem`"01") (pre ++ per) && not (null per) of+ True -> Just (map b pre, map b per)+ _ -> Nothing+ _ -> Nothing+ _ -> Nothing+ _ -> Nothing+ where+ b '0' = False+ b '1' = True+ b c = error $ "parseBinAngle.b " ++ [c] --- | Binary representation of a (pre-)periodic angle.-type BinAngle = ([Bool], [Bool])+-- | Preperiod under angle doubling.+bpreperiod :: BinAngle -> Int+bpreperiod (pre, _) = length pre +-- | Period under angle doubling.+bperiod :: BinAngle -> Int+bperiod (_, per) = length per+ -- | Convert an angle from binary representation. unbinary :: BinAngle -> Angle unbinary (pre, per)- | n == 0 = bits pre % (2 ^ m)- | otherwise = (bits pre % (2 ^ m)) + (bits per % (2 ^ m * (2 ^ n - 1)))+ | n == 0 = bits pre % (1 `shiftL` m)+ | otherwise = (bits pre * ((1 `shiftL` n) - 1) + bits per) % (((1 `shiftL` n) - 1) `shiftL` m) where m = length pre n = length per@@ -82,21 +182,21 @@ -- | Convert an angle to binary representation. binary :: Angle -> BinAngle-binary a- | a == 0 = ([], [])- | even (denominator a) =- let (pre, per) = binary (double a)- b = a >= 1/2- in (b:pre, per)- | otherwise =- let (t, p) = head . dropWhile ((1 /=) . denominator . fst) . map (\q -> (a * (2^q - 1), q)) $ [ (1 :: Int) ..]- s = numerator t- n = fromIntegral p- per = [ s `testBit` i | i <- [n - 1, n - 2 .. 0] ]- in ([], per)+binary = binary' . wrap+ where+ binary' a+ | a == zero = ([], [False])+ | even (denominator a) =+ let ~(pre, per) = binary' (double a)+ in ((a >= half) : pre, per)+ | otherwise = ([], (a >= half) : binary'' (doubleOdd a))+ where+ binary'' a'+ | a' == a = []+ | otherwise = (a' >= half) : binary'' (doubleOdd a') -- | Tuning transformation for binary represented periodic angles.--- Probably only valid for angle pairs presenting ray pairs.+-- Probably only valid for angle pairs representing hyperbolic components. btune :: BinAngle -> (BinAngle, BinAngle) -> BinAngle btune (tpre, tper) (([], per0), ([], per1)) = (concatMap f tpre, concatMap f tper) where@@ -105,6 +205,7 @@ btune _ _ = error "btune: can't handle pre-periods" -- | Tuning transformation for angles.+-- Probably only valid for angle pairs representing hyperbolic components. tune :: Angle -> (Angle, Angle) -> Angle tune t (t0, t1) = unbinary $ btune (binary t) (binary t0, binary t1) @@ -139,46 +240,47 @@ -- | The kneading sequence for an external angle. kneading :: Angle -> Kneading kneading a0'- | a0 == 0 = StarPeriodic [Star]- | otherwise = fst kneads+ | a0 == zero = StarPeriodic [Star]+ | otherwise = case span (even . denominator . fst) . kneading' $ a0 of+ (pre, ak1@(a1,_):aks) -> case takeWhile ((a1 /=) . fst) aks of+ aks' ->+ let per = map snd $ ak1 : aks'+ in case (null pre, last per) of+ (True, Star) -> StarPeriodic per+ (True, _) -> Periodic (canonical per)+ (False, _) -> PrePeriodic (map snd pre) (canonical per)+ ppp -> error $ "kneading: " ++ show a0' ++ " " ++ show ppp where a0 = wrap a0'- lo = a0 / 2- hi = (a0 + 1) / 2- kneads = kneading' 1 (double a0)- ks = (a0, One) : snd kneads- kneading' :: Integer -> Angle -> (Kneading, [(Angle, Knead)])- kneading' n a- | isJust i = case i of- Just 0 -> case last qs of- Star -> (StarPeriodic qs, [])- _ -> (Periodic qs, [])- Just j -> let (p, q) = genericSplitAt j qs- in (PrePeriodic p q, [])- _ -> error "Fractal.Mandelbrot.Address.kneading (isJust -> Nothing?)"- | a == lo = ((a, Star):) `mapP` k- | a == hi = ((a, Star):) `mapP` k- | lo < a && a < hi = ((a, One ):) `mapP` k- | hi < a || a < lo = ((a, Zero):) `mapP` k- | otherwise = error "Fractal.Mandelbrot.Address.kneading (unmatched?)"- where- k = kneading' (n+1) (double a)- ps = genericTake n ks- qs = map snd ps- i = fmap fst . listToMaybe . filter ((a ==) . fst . snd) . zip [(0 :: Integer) ..] $ ps- mapP f ~(x, y) = (x, f y)+ (lo, hi) = preimages a0+ kneading' :: Angle -> [(Angle, Knead)]+ kneading' a+ | even (denominator a) = (a, knead a) : kneading' (double a)+ | otherwise = kneading'' a+ kneading'' :: Angle -> [(Angle, Knead)]+ kneading'' a = (a, knead a) : kneading'' (doubleOdd a)+ knead a+ | a == lo = Star+ | a == hi = Star+ | lo < a && a < hi = One+ | hi < a || a < lo = Zero+ | otherwise = error $ "knead " ++ show a ++ " " ++ show lo ++ " " ++ show hi+ canonical ks = headNote "kneading canonical" ([ ks' | m <- [1..n], n `mod` m == 0, let ks' = take m ks, ks == take n (cycle ks') ])+ where n = length ks -- | The period of a kneading sequence, or 'Nothing' when it isn't periodic.-period :: Kneading -> Maybe Integer-period (StarPeriodic k) = Just (genericLength k)-period (Periodic k) = Just (genericLength k)+period :: Kneading -> Maybe Int+period (StarPeriodic k) = Just (length k)+period (Periodic k) = Just (length k) period _ = Nothing -rho :: Kneading -> Integer -> Integer-rho v r | r >= 1 && fmap (r`mod`) (period v) /= Just 0 = ((1 + r) +) . genericLength . takeWhile id . zipWith (==) vs . genericDrop r $ vs- | otherwise = rho v (r + 1)+rho :: Kneading -> Int -> Int+rho v = rho' where- vs = unwrap v+ rho' r+ | r >= 1 && r `mod` n /= 0 = ((1 + r) +) . length . takeWhile id . zipWith (==) (unwrap v) . drop r $ (unwrap v)+ | otherwise = rho' (r + 1)+ Just n = period v -- | Unwrap a kneading sequence to an infinite list. unwrap :: Kneading -> [Knead]@@ -192,7 +294,7 @@ -- | Internal addresses are a non-empty sequence of strictly increasing -- integers beginning with '1'.-data InternalAddress = InternalAddress [Integer]+data InternalAddress = InternalAddress [Int] deriving (Read, Show, Eq, Ord, Data, Typeable) -- | Internal address as a string.@@ -202,7 +304,7 @@ prettyInternalAddress (InternalAddress (x:ys)) = show x ++ " " ++ prettyInternalAddress (InternalAddress ys) -- | Construct a valid 'InternalAddress', checking the precondition.-internalFromList :: [Integer] -> Maybe InternalAddress+internalFromList :: [Int] -> Maybe InternalAddress internalFromList x0s@(1:_) = InternalAddress `fmap` fromList' 0 x0s where fromList' n [x] | x > n = Just [x]@@ -211,39 +313,39 @@ internalFromList _ = Nothing -- | Extract the sequence of integers.-internalToList :: InternalAddress -> [Integer]+internalToList :: InternalAddress -> [Int] internalToList (InternalAddress xs) = xs -- | Construct an 'InternalAddress' from a kneading sequence. internalAddress :: Kneading -> Maybe InternalAddress internalAddress (StarPeriodic [Star]) = Just (InternalAddress [1])-internalAddress (StarPeriodic v@(One:_)) = Just . InternalAddress . address'per (genericLength v) $ v-internalAddress (Periodic v@(One:_)) = Just . InternalAddress . address'per (genericLength v) $ v+internalAddress (StarPeriodic v@(One:_)) = Just . InternalAddress . address'per (length v) $ v+internalAddress (Periodic v@(One:_)) = Just . InternalAddress . address'per (length v) $ v internalAddress k@(Aperiodic (One:_)) = Just . InternalAddress . address'inf . unwrap $ k internalAddress _ = Nothing -address'inf :: [Knead] -> [Integer]+address'inf :: [Knead] -> [Int] address'inf v = address' v -address'per :: Integer -> [Knead] -> [Integer]+address'per :: Int -> [Knead] -> [Int] address'per p v = takeWhile (<= p) $ address' v -address' :: [Knead] -> [Integer]+address' :: [Knead] -> [Int] address' v = address'' 1 [One] where address'' sk vk = sk : address'' sk' vk' where- sk' = (1 +) . genericLength . takeWhile id . zipWith (==) v . cycle $ vk- vk' = genericTake sk' (cycle v)+ sk' = (1 +) . length . takeWhile id . zipWith (==) v . cycle $ vk+ vk' = take sk' (cycle v) -- | A star-periodic kneading sequence's upper and lower associated -- kneading sequences. associated :: Kneading -> Maybe (Kneading, Kneading) associated (StarPeriodic k) = Just (Periodic a, Periodic abar) where- n = genericLength k+ n = length k divisors = [ m | m <- [1 .. n], n `mod` m == 0 ]- abar = head . filter (and . zipWith (==) a' . cycle) . map (`genericTake` a') $ divisors+ abar = headNote "associated abar" . filter (and . zipWith (==) a' . cycle) . map (`take` a') $ divisors (a, a') = if ((n `elem`) . internalToList) `fmap` internalAddress (Periodic a1) == Just True then (a1, a2) else (a2, a1) a1 = map (\s -> case s of Star -> Zero ; t -> t) k a2 = map (\s -> case s of Star -> One ; t -> t) k@@ -260,57 +362,57 @@ -- | Angled internal addresses have angles between each integer in an -- internal address. data AngledInternalAddress- = Unangled Integer- | Angled Integer Angle AngledInternalAddress+ = Unangled Int+ | Angled Int Angle AngledInternalAddress deriving (Read, Show, Eq, Ord, Data, Typeable) -- | Angled internal address as a string. prettyAngledInternalAddress :: AngledInternalAddress -> String prettyAngledInternalAddress (Unangled n) = show n prettyAngledInternalAddress (Angled n r a)- | r /= 1/2 = show n ++ " " ++ show (numerator r) ++ "/" ++ show (denominator r) ++ " " ++ prettyAngledInternalAddress a+ | r /= half = show n ++ " " ++ show (numerator r) ++ "/" ++ show (denominator r) ++ " " ++ prettyAngledInternalAddress a | otherwise = show n ++ " " ++ prettyAngledInternalAddress a -- | Builds a valid 'AngledInternalAddress' from a list, checking the -- precondition that only the last 'Maybe Angle' should be 'Nothing', -- and the 'Integer' must be strictly increasing.-angledFromList :: [(Integer, Maybe Angle)] -> Maybe AngledInternalAddress+angledFromList :: [(Int, Maybe Angle)] -> Maybe AngledInternalAddress angledFromList = fromList' 0 where fromList' x [(n, Nothing)] | n > x = Just (Unangled n)- fromList' x ((n, Just r) : xs) | n > x && 0 < r && r < 1 = Angled n r `fmap` fromList' n xs+ fromList' x ((n, Just r) : xs) | n > x && zero < r && r < one = Angled n r `fmap` fromList' n xs fromList' _ _ = Nothing -unsafeAngledFromList :: [(Integer, Maybe Angle)] -> AngledInternalAddress+unsafeAngledFromList :: [(Int, Maybe Angle)] -> AngledInternalAddress unsafeAngledFromList = fromList' 0 where fromList' x [(n, Nothing)] | n > x = Unangled n- fromList' x ((n, Just r) : xs) | n > x && 0 < r && r < 1 = Angled n r (fromList' n xs)+ fromList' x ((n, Just r) : xs) | n > x && zero < r && r < one = Angled n r (fromList' n xs) fromList' _ _ = error "Fractal.Mandelbrot.Address.unsafeAngledFromList" -- | Convert an 'AngledInternalAddress' to a list.-angledToList :: AngledInternalAddress -> [(Integer, Maybe Angle)]+angledToList :: AngledInternalAddress -> [(Int, Maybe Angle)] angledToList (Unangled n) = [(n, Nothing)] angledToList (Angled n r a) = (n, Just r) : angledToList a -denominators :: InternalAddress -> Kneading -> [Integer]+denominators :: InternalAddress -> Kneading -> [Int] denominators a v = denominators' (internalToList a) where denominators' (s0:ss@(s1:_)) = let rr = r s0 s1- in (((s1 - rr) `div` s0) + if s0 `elem` takeWhile (<= s0) (orbit p rr) then 1 else 2) : denominators' ss+ in (((s1 - rr) `div` s0) + if (s0 ==) . headNote "denominators" . dropWhile (< s0) . orbit p $ rr then 1 else 2) : denominators' ss denominators' _ = [] r s s' = case s' `mod` s of 0 -> s t -> t p = rho v -numerators :: Angle -> InternalAddress -> [Integer] -> [Integer]+numerators :: Angle -> InternalAddress -> [Int] -> [Int] numerators r a qs = zipWith num (internalToList a) qs where- num s q = genericLength . filter (<= r) . map (genericIndex rs) $ [0 .. q - 2]+ num s q = length . filter (<= r) . map (rs !!) $ [0 .. q - 2] where- rs = iterate (foldr (.) id . genericReplicate s $ double) r+ rs = iterate (\t -> foldr (.) id (replicate s (if even (denominator t) then double else doubleOdd)) $ t) (wrap r) -- | The angled internal address corresponding to an external angle. angledInternalAddress :: Angle -> Maybe AngledInternalAddress@@ -320,7 +422,7 @@ i <- internalAddress k let d = denominators i k n = numerators r i d- return . unsafeAngledFromList . zip (internalToList i) . (++ [Nothing]) . map Just . zipWith (%) n $ d+ return . unsafeAngledFromList . zip (internalToList i) . (++ [Nothing]) . map Just . zipWith (\a b -> fromIntegral a % fromIntegral b) n $ d -- | Split an angled internal address at the last island. splitAddress :: AngledInternalAddress -> (AngledInternalAddress, [Angle])@@ -330,7 +432,7 @@ rs1 = reverse (Nothing : init rs0) prs1 = zip ps1 rs1 f ((p, Just r):qrs@((q, _):_)) acc- | p == denominator r * q = f qrs (r : acc)+ | p == fromIntegral (denominator r) * q = f qrs (r : acc) f prs acc = g prs acc g prs acc = let (ps2, rs2) = unzip prs@@ -344,11 +446,11 @@ -- | The inverse of 'splitAddress'. joinAddress :: AngledInternalAddress -> [Angle] -> AngledInternalAddress joinAddress (Unangled p) [] = Unangled p-joinAddress (Unangled p) (r:rs) = Angled p r (joinAddress (Unangled $ p * denominator r) rs)+joinAddress (Unangled p) (r:rs) = Angled p r (joinAddress (Unangled $ p * fromIntegral (denominator r)) rs) joinAddress (Angled p r a) rs = Angled p r (joinAddress a rs) -- | The period of an angled internal address.-addressPeriod :: AngledInternalAddress -> Integer+addressPeriod :: AngledInternalAddress -> Int addressPeriod (Unangled p) = p addressPeriod (Angled _ _ a) = addressPeriod a @@ -358,10 +460,10 @@ -- | The pair of external angles whose rays land at the root of the -- hyperbolic component described by the angled internal address.-externalAngles :: AngledInternalAddress -> Maybe (Rational, Rational)-externalAngles = externalAngles' 1 (0, 1)+externalAngles :: AngledInternalAddress -> Maybe (Angle, Angle)+externalAngles = externalAngles' 1 (zero, one) -externalAngles' :: Integer -> (Rational, Rational) -> AngledInternalAddress -> Maybe (Rational, Rational)+externalAngles' :: Int -> (Angle, Angle) -> AngledInternalAddress -> Maybe (Angle, Angle) externalAngles' p0 lohi a0@(Unangled p) | p0 /= p = case wakees lohi p of [lh] -> externalAngles' p lh a0@@ -372,111 +474,93 @@ [lh] -> externalAngles' p lh a0 _ -> Nothing | otherwise = do-{- let num = numerator r den = denominator r- q = p * den- ws = wakees lohi q- nums = [ num' | num' <- [ 1.. den - 1 ], let r' = num' % den, denominator r' == den ]- nws, nnums :: Integer- nws = genericLength ws- nnums = genericLength nums- guard (nws == nnums)- i <- genericElemIndex num nums- lh <- safeGenericIndex ws (i :: Integer)- externalAngles' q lh a--}- let num = numerator r- den = denominator r- ws = wakees (0, 1) den- nums = [ num' | num' <- [ 1.. den - 1 ], let r' = num' % den, denominator r' == den ]- nws, nnums :: Integer- nws = genericLength ws- nnums = genericLength nums+ ws = wakees (zero, one) (fromIntegral den)+ nums = [ num' | num' <- [ 1.. den - 1 ], let r' = num' % den :: Angle, denominator r' == den ]+ nws, nnums :: Int+ nws = length ws+ nnums = length nums guard (nws == nnums)- i <- genericElemIndex num nums- (l,h) <- safeGenericIndex ws (i :: Integer)- externalAngles' (p * den) (if p > 1 then (tune l lohi, tune h lohi) else (l, h)) a-wakees :: (Rational, Rational) -> Integer -> [(Rational, Rational)]+ i <- elemIndex num nums+ (l,h) <- safeIndex ws i+ externalAngles' (p * fromIntegral den) (if p > 1 then (tune l lohi, tune h lohi) else (l, h)) a+wakees :: (Angle, Angle) -> Int -> [(Angle, Angle)] wakees (lo, hi) q =- let gaps (l, h) n- | n == 0 = [(l, h)]--- | h - l < 1 % (2 ^ n - 1) = [(l, h)]- | n > 0 = let gs = gaps (l, h) (n - 1)+ let gaps (l :!: h) n+ | n == 0 = [(l :!: h)]+ | n > 0 = let gs = gaps (l :!: h) (n - 1) cs = candidates n gs in accumulate cs gs | otherwise = error "Fractal.Mandelbrot.Address.gaps !(n >= 0)" candidates n gs =- let den = 2 ^ n - 1+ let den = (1 `shiftL` n) - 1 in [ r- | (l, h) <- gs- , num <- [ ceiling (l * fromInteger den)- .. floor (h * fromInteger den) ]+ | (l :!: h) <- gs+ , num <- [ ceiling' l n .. floor' h n ]+ , fullperiod n num , let r = num % den , l < r, r < h- , period (kneading r) == Just n ] accumulate [] ws = ws accumulate (l : h : lhs) ws =- let (ls, ms@((ml, _):_)) = break (l `inside`) ws- (_s, (_, rh):rs) = break (h `inside`) ms- in ls ++ [(ml, l)] ++ accumulate lhs ((h, rh) : rs)+ let (ls, ms@((ml :!: _):_)) = break (l `inside`) ws+ (_s, (_ :!: rh):rs) = break (h `inside`) ms+ in ls ++ [(ml :!: l)] ++ accumulate lhs ((h :!: rh) : rs) accumulate _ _ = error "Fractal.Mandelbrot.Address.gaps !even"- inside x (l, h) = l < x && x < h- in chunk2 . candidates q . gaps (lo, hi) $ (q - 1)+ inside x (l :!: h) = l < x && x < h+ fullperiod bs = \n -> and [ (((n `shiftR` b) .|. (n `shiftL` (bs - b))) .&. mask) /= n | b <- factors ]+ where+ factors = [ b | b <- [ bs - 1, bs - 2 .. 1 ], bs `mod` b == 0 ]+ mask = (1 `shiftL` bs) - 1+ in chunk2 . candidates q . gaps (lo :!: hi) $ (q - 1) chunk2 :: [t] -> [(t, t)] chunk2 [] = [] chunk2 (x:y:zs) = (x, y) : chunk2 zs chunk2 _ = error "Fractal.Mandelbrot.Address.chunk2 !even" -genericElemIndex :: (Eq a, Integral b) => a -> [a] -> Maybe b-genericElemIndex _ [] = Nothing-genericElemIndex e (f:fs)- | e == f = Just 0- | otherwise = (1 +) `fmap` genericElemIndex e fs--safeGenericIndex :: Integral b => [a] -> b -> Maybe a-safeGenericIndex [] _ = Nothing-safeGenericIndex (x:xs) i+safeIndex :: [a] -> Int -> Maybe a+safeIndex [] _ = Nothing+safeIndex (x:xs) i | i < 0 = Nothing- | i > 0 = safeGenericIndex xs (i - 1)+ | i > 0 = safeIndex xs (i - 1) | otherwise = Just x -- | Parse an angle. parseAngle :: String -> Maybe Angle-parseAngle s = case runP pFraction () "" s of+parseAngle s = case runParser pFraction () "" s of Left _ -> Nothing Right f -> Just (unFraction f) -- | Parse a list of angles. parseAngles :: String -> Maybe [Angle]-parseAngles s = case runP (many pFraction) () "" s of+parseAngles s = case runParser (many pFraction) () "" s of Left _ -> Nothing Right fs -> Just (map unFraction fs) -- | Parse a kneading element. parseKnead :: String -> Maybe Knead-parseKnead s = case runP pKnead () "" s of+parseKnead s = case runParser pKnead () "" s of Left _ -> Nothing Right k -> Just k -- | Parse a non-aperiodic kneading sequence. parseKneading :: String -> Maybe Kneading-parseKneading s = case runP pKneading () "" s of+parseKneading s = case runParser pKneading () "" s of Left _ -> Nothing Right ks -> Just ks -- | Parse an internal address. parseInternalAddress :: String -> Maybe InternalAddress-parseInternalAddress s = case runP (many pNumber) () "" s of+parseInternalAddress s = case runParser (many pNumber) () "" s of Left _ -> Nothing- Right ns -> internalFromList (map unNumber ns)+ Right ns -> internalFromList (map (fromIntegral . unNumber) ns) -- | Parse an angled internal address, accepting some unambiguous -- abbreviations. parseAngledInternalAddress :: String -> Maybe AngledInternalAddress-parseAngledInternalAddress s = case runP parser () "" s of+parseAngledInternalAddress s = case runParser parser () "" s of Left _ -> Nothing Right a -> Just a @@ -498,17 +582,17 @@ ts <- pTokens accum 1 ts where- accum p [] = return $ Unangled p- accum _ [Number n] = return $ Unangled n+ accum p [] = return $ Unangled (fromIntegral p)+ accum _ [Number n] = return $ Unangled (fromIntegral n) accum _ (Number n : ts@(Number _ : _)) = do a <- accum n ts- return $ Angled n (1%2) a+ return $ Angled (fromIntegral n) (1%2) a accum _ (Number n : Fraction t b : ts) = do a <- accum (n * b) ts- return $ Angled n (t%b) a+ return $ Angled (fromIntegral n) (t%b) a accum p (Fraction t b : ts) = do a <- accum (p * b) ts- return $ Angled p (t % b) a+ return $ Angled (fromIntegral p) (t % b) a pTokens :: Parse [Token] pTokens = do
Fractal/RUFF/Mandelbrot/Atom.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns #-} {- | Module : Fractal.RUFF.Mandelbrot.Atom-Copyright : (c) Claude Heiland-Allen 2011+Copyright : (c) Claude Heiland-Allen 2011,2015 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable @@ -19,20 +19,20 @@ import Control.Arrow ((***)) import Data.Maybe (listToMaybe)-import Data.Ratio ((%)) import Data.Vec (NearZero, nearZero) import Fractal.RUFF.Mandelbrot.Address (AngledInternalAddress, Angle, splitAddress, addressPeriod, externalAngles, angledInternalAddress) import Fractal.RUFF.Mandelbrot.Nucleus (findNucleus, findBond, findPeriod) import Fractal.RUFF.Mandelbrot.Ray (externalRay, externalRayOut) import Fractal.RUFF.Types.Complex (Complex, magnitude, magnitude2, phase, mkPolar)+import Fractal.RUFF.Types.Ratio ((%), fromQ) -- | Mu-atom properties. data MuAtom r = MuAtom { muNucleus :: !(Complex r) , muSize :: !Double , muOrient :: !Double- , muPeriod :: !Integer+ , muPeriod :: !Int } deriving (Read, Show, Eq) @@ -41,15 +41,15 @@ = AtomSplitTodo | AtomSplitDone AngledInternalAddress [Angle] | AtomAnglesTodo- | AtomAnglesDone !Rational !Rational+ | AtomAnglesDone !Angle !Angle | AtomRayTodo- | AtomRay !Integer+ | AtomRay !Int | AtomRayDone !(Complex r) | AtomNucleusTodo- | AtomNucleus !Integer+ | AtomNucleus !Int | AtomNucleusDone !(Complex r) | AtomBondTodo- | AtomBond !Integer+ | AtomBond !Int | AtomBondDone !(Complex r) | AtomSuccess !(MuAtom r) | AtomFailed@@ -75,8 +75,8 @@ er = 65536 accuracy = 1e-10 ok w = magnitude2 w < 2 * er ^ (2::Int) -- NaN -> False- rayl = externalRay accuracy sharpness er lo- rayh = externalRay accuracy sharpness er hi+ rayl = externalRay accuracy sharpness er (fromQ lo)+ rayh = externalRay accuracy sharpness er (fromQ hi) ray' = takeWhile (uncurry (&&) . (ok *** ok) . snd) $ [ 1 .. ] `zip` (rayl `zip` rayh) rgo [] _ = [AtomFailed] rgo [_] _ = [AtomFailed]@@ -126,13 +126,13 @@ = AddressCuspTodo | AddressCuspDone !(Complex r) | AddressDwellTodo- | AddressDwell !Integer- | AddressDwellDone !Integer+ | AddressDwell !Int+ | AddressDwellDone !Int | AddressRayOutTodo | AddressRayOut !Double | AddressRayOutDone !(Complex r) | AddressExternalTodo- | AddressExternalDone !Rational+ | AddressExternalDone !Angle | AddressAddressTodo | AddressSuccess AngledInternalAddress | AddressFailed@@ -161,7 +161,7 @@ accuracy = 1e-16 sharpness = 16 epsilon0 = realToFrac (muSize mu) * accuracy- in rgo ([(1 :: Integer) ..] `zip` externalRayOut (fromIntegral n + 100) epsilon0 accuracy sharpness er cusp) $ \rend -> AddressExternalTodo :+ in rgo ([(1 :: Int) ..] `zip` externalRayOut (fromIntegral n + 100) epsilon0 accuracy sharpness er cusp) $ \rend -> AddressExternalTodo : let den = 2 ^ muPeriod mu - 1 num' = fromIntegral den * warp (phase rend / (2 * pi)) num = round num'@@ -185,12 +185,12 @@ data Locate r = LocateScanTodo | LocateScan- | LocateScanDone !Integer+ | LocateScanDone !Int | LocateNucleusTodo- | LocateNucleus !Integer+ | LocateNucleus !Int | LocateNucleusDone !(Complex r) | LocateBondTodo- | LocateBond !Integer+ | LocateBond !Int | LocateBondDone !(Complex r) | LocateSuccess !(MuAtom r) | LocateFailed
Fractal/RUFF/Mandelbrot/Image.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns, DeriveDataTypeable #-} {- | Module : Fractal.RUFF.Mandelbrot.Image-Copyright : (c) Claude Heiland-Allen 2011+Copyright : (c) Claude Heiland-Allen 2011,2015 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable @@ -21,13 +21,13 @@ import Data.Array.ST (newArray, writeArray, runSTUArray) import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef) import Data.Array.Unboxed (UArray, (!), bounds, range, amap, ixmap)+import Data.Strict.Tuple (Pair((:!:))) import Data.Ix (Ix) import Data.Data (Data) import Data.Typeable (Typeable) import Fractal.RUFF.Types.Complex (Complex((:+)), magnitude)-import Fractal.RUFF.Types.Tuple (Tuple2(Tuple2)) import Fractal.RUFF.Mandelbrot.Iterate (iterates, initial, Mode(Simple, DistanceEstimate), Iterate(), Output(OutSimple, OutDistanceEstimate), escapeTime, distanceEstimate, finalAngle, outUser) -- | Render an image with the 'Simple' algorithm. The iteration count is@@ -43,7 +43,7 @@ imageLoop s a n0 0 False 64 i0s (out s a) where i0s = map (uncurry $ initial Simple) cs- out s a (OutSimple{ outUser = Tuple2 j i }) = do+ out s a (OutSimple{ outUser = j :!: i }) = do writeArray a (j, i) False modifySTRef' s (+ 1) out _ _ _ = return ()@@ -64,7 +64,7 @@ (_, cx0):(_, cx1):_ = cs pixelSpacing = magnitude (cx1 - cx0) i0s = map (uncurry $ initial DistanceEstimate) cs- out !s !a (OutDistanceEstimate{ escapeTime = et, distanceEstimate = de, finalAngle = fa, outUser = Tuple2 j i }) = {-# SCC "complexImage.out" #-} do+ out !s !a (OutDistanceEstimate{ escapeTime = et, distanceEstimate = de, finalAngle = fa, outUser = j :!: i }) = {-# SCC "complexImage.out" #-} do writeArray a (j, i, EscapeTime) (realToFrac et) writeArray a (j, i, DistanceEstimate') (realToFrac (de / pixelSpacing)) writeArray a (j, i, FinalAngle) (realToFrac fa)@@ -87,7 +87,7 @@ if null is || (f && o == 0) || n > n0 then return a else loop (f || o > 0) (n + m) (m * 2) is' -- | Image bounds and coordinates.-type Coordinates r = (((Int,Int),(Int,Int)), [(Tuple2 Int Int, Complex r)])+type Coordinates r = (((Int,Int),(Int,Int)), [(Pair Int Int, Complex r)]) -- | The parameter plane coordinates for an image, with bounds. coordinates :: (Ord r, Floating r) => Int {- ^ width -} -> Int {- ^ height -} -> Complex r {- ^ center -} -> r {- ^ size -} -> Coordinates r@@ -95,7 +95,7 @@ coordinates !width !height !(c0r :+ c0i) !r0 = (bs, cs) where bs = ((0, 0), (height - 1, width - 1))- cs = [ (Tuple2 j i, c)+ cs = [ (j :!: i, c) | (j,i) <- range bs , let y = (fromIntegral j - h) / h , let x = (fromIntegral i - w) / h
Fractal/RUFF/Mandelbrot/Iterate.hs view
@@ -4,7 +4,7 @@ Copyright : (c) Claude Heiland-Allen 2011 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable
Fractal/RUFF/Mandelbrot/Nucleus.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns #-} {- | Module : Fractal.RUFF.Mandelbrot.Nucleus-Copyright : (c) Claude Heiland-Allen 2011+Copyright : (c) Claude Heiland-Allen 2011,2015 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable @@ -12,7 +12,6 @@ -} module Fractal.RUFF.Mandelbrot.Nucleus (findPeriod, findNucleus, findBond, findInternal) where -import Data.List (genericIndex) import Data.Maybe (listToMaybe) import Fractal.RUFF.Types.Complex (Complex((:+)), mkPolar, magnitude2) @@ -23,12 +22,12 @@ -- /Newton-Raphson method/ -- <http://mrob.com/pub/muency/newtonraphsonmethod.html>. ---findNucleus :: (Floating r, Fractional r) => Integer {- ^ period -} -> Complex r {- ^ estimate -} -> [Complex r]+findNucleus :: (Floating r, Fractional r) => Int {- ^ period -} -> Complex r {- ^ estimate -} -> [Complex r] findNucleus p g = iterate go g where go !c = let step (!z, !d) = (z * z + c, 2 * z * d + 1)- (zn, dn) = iterate step (0, 0) `genericIndex` p+ (zn, dn) = iterate step (0, 0) !! p in c - zn / dn -- | Given the period and nucleus, find succesive refinements to the@@ -37,13 +36,13 @@ -- The algorithm is based on ideas from -- <http://mrob.com/pub/muency/derivative.html>. ---findBond :: (Floating r, Fractional r) => Integer {- ^ period -} -> Complex r {- ^ nucleus -} -> r {- ^ angle -} -> [Complex r]+findBond :: (Floating r, Fractional r) => Int {- ^ period -} -> Complex r {- ^ nucleus -} -> r {- ^ angle -} -> [Complex r] findBond p c0 a0 = findInternal p c0 1 a0 -- | Given the period and nucleus, find an interior point at a given internal -- angle and radius in (0,1]. ---findInternal :: (Floating r, Fractional r) => Integer {- ^ period -} -> Complex r {- ^ nucleus -} -> r {- ^ radius -} -> r {- ^ angle -} -> [Complex r]+findInternal :: (Floating r, Fractional r) => Int {- ^ period -} -> Complex r {- ^ nucleus -} -> r {- ^ radius -} -> r {- ^ angle -} -> [Complex r] findInternal p c0 r0 a0 = snd `map` iterate go (c0, c0) where b0 = mkPolar r0 (2 * pi * a0)@@ -55,7 +54,7 @@ , 2 * a * d + 1 , 2 * (a * e + b * d) )- (an, bn, cn, dn, en) = iterate step (z1, 1, 0, 0, 0) `genericIndex` p+ (an, bn, cn, dn, en) = iterate step (z1, 1, 0, 0, 0) !! p y0 = z1 - an y1 = b0 - bn bn1 = bn - 1@@ -70,7 +69,7 @@ -- /Finding the Period of a mu-Atom/ -- <http://mrob.com/pub/muency/period.html>. ---findPeriod :: (Floating r, Ord r) => Integer {- ^ maximum period -} -> r {- ^ radius -} -> Complex r {- ^ center -} -> Maybe Integer+findPeriod :: (Floating r, Ord r) => Int {- ^ maximum period -} -> r {- ^ radius -} -> Complex r {- ^ center -} -> Maybe Int findPeriod m r c = let cs = [ c + (r:+r), c + (r:+(-r)), c + ((-r):+(-r)), c + ((-r):+r) ] zs = iterate (zipWith (\cc z -> z * z + cc) cs) [0,0,0,0]
Fractal/RUFF/Mandelbrot/Ray.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns #-} {- | Module : Fractal.RUFF.Mandelbrot.Ray-Copyright : (c) Claude Heiland-Allen 2011+Copyright : (c) Claude Heiland-Allen 2011,2015 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable @@ -18,7 +18,7 @@ import Data.Maybe (fromMaybe) import Fractal.RUFF.Types.Complex (Complex, magnitude2, magnitude, phase, mkPolar)-import Fractal.RUFF.Mandelbrot.Address (Angle, double)+import Fractal.RUFF.Types.Ratio (double) -- | Compute the external ray for an external angle with a given -- accuracy, sharpness and starting radius. For example:@@ -29,7 +29,7 @@ -- /An algorithm to draw external rays of the Mandelbrot set/ -- <http://www.math.nagoya-u.ac.jp/~kawahira/programs/mandel-exray.pdf>. ---externalRay :: (Ord r, Floating r) => r {- ^ accuracy -} -> Int {- ^ sharpness -} -> r {- ^ radius -} -> Angle {- ^ external angle -} -> [Complex r]+externalRay :: (Ord r, Floating r) => r {- ^ accuracy -} -> Int {- ^ sharpness -} -> r {- ^ radius -} -> Rational {- ^ external angle -} -> [Complex r] externalRay accuracy sharpness radius angle = map fst3 . iterate step $ (mkPolar radius (2 * pi * fromRational angle), accuracy * radius, (0, 0)) where fst3 (x, _, _) = x
Fractal/RUFF/Types/Complex.hs view
@@ -4,7 +4,7 @@ Copyright : (c) Claude Heiland-Allen 2011 License : BSD3 -Maintainer : claudiusmaximus@goto10.org+Maintainer : claude@mathr.co.uk Stability : unstable Portability : portable
+ Fractal/RUFF/Types/Ratio.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{- |+Module : Fractal.RUFF.Types.Ratio+Copyright : (c) Claude Heiland-Allen 2015+License : BSD3++Maintainer : claude@mathr.co.uk+Stability : unstable+Portability : TypeFamilies++Rational numbers with ruff-specific operations.+-}++module Fractal.RUFF.Types.Ratio+ ( Q(..)+ , Ratio(..)+ , Rational+ ) where++import Data.Data (Data)+import Data.Typeable (Typeable)+import Prelude hiding (Rational)+import qualified Data.Ratio as Ratio++-- | Rational numbers with ruff-specific operations.+class Q r where+ {-# MINIMAL (%), numerator, denominator #-}++ type Z r++ infixl 7 %, %!++ -- | smart constuctor+ (%) :: Z r -> Z r -> r+ -- | extract numerator+ numerator :: r -> Z r+ -- | extract denominator+ denominator :: r -> Z r++ -- | unsafe constructor+ {-# INLINE (%!) #-}+ (%!) :: Z r -> Z r -> r+ (%!) = (%)++ -- | 0+ {-# INLINE zero #-}+ zero :: Integral (Z r) => r+ zero = 0 %! 1++ -- | 1/2+ {-# INLINE half #-}+ half :: Integral (Z r) => r+ half = 1 %! 2++ -- | 1+ {-# INLINE one #-}+ one :: Integral (Z r) => r+ one = 1 %! 1++ -- | convert to Prelude.Rational+ {-# INLINE fromQ #-}+ fromQ :: Integral (Z r) => r -> Ratio.Rational+ fromQ x = toInteger (numerator x) %! toInteger (denominator x)++ -- | convert from Prelude.Rational+ {-# INLINE toQ #-}+ toQ :: Integral (Z r) => Ratio.Rational -> r+ toQ x = fromInteger (Ratio.numerator x) %! fromInteger (Ratio.denominator x)++ -- | wrap into [0,1)+ {-# INLINE wrap #-}+ wrap :: Integral (Z r) => r -> r+ wrap x = (numerator x `mod` denominator x) %! denominator x++ -- | doubling map to [0,1)+ {-# INLINE doubleWrap #-}+ doubleWrap :: Integral (Z r) => r -> r+ doubleWrap = {-# SCC "doubleWrap" #-} double . wrap++ -- | doubling map from [0,1) to [0,1)+ {-# INLINE double #-}+ double :: Integral (Z r) => r -> r+ double x = {-# SCC "double" #-} case () of+ _| even d -> (if n < d' then n else n - d') % d'+ | otherwise -> (if n' < d then n' else n' - d) %! d+ where+ d = denominator x+ d' = d `div` 2+ n = numerator x+ n' = 2 * n++ -- | doubling map from [0,1) to [0,1) for odd denominator+ {-# INLINE doubleOdd #-}+ doubleOdd :: Integral (Z r) => r -> r+ doubleOdd x = {-# SCC "doubleOdd" #-} (if n' < d then n' else n' - d) %! d+ where+ d = denominator x+ n = numerator x+ n' = 2 * n++ -- | doubling map preimages from [0,1) to [0,1)x[0,1)+ {-# INLINE preimages #-}+ preimages :: Integral (Z r) => r -> (r, r)+ preimages x = (n % d', (n + d) % d')+ where+ n = numerator x+ d = denominator x+ d' = 2 * d+++instance Integral a => Q (Ratio.Ratio a) where+ {-# SPECIALIZE instance Q Ratio.Rational #-}+ type Z (Ratio.Ratio a) = a+ {-# INLINE (%) #-}+ (%) = (Ratio.%)+ {-# INLINE numerator #-}+ numerator = Ratio.numerator+ {-# INLINE denominator #-}+ denominator = Ratio.denominator+++-- | Ratio data structure+data Ratio a = !a :% !a deriving (Eq, Data, Typeable)++-- | Rational type+type Rational = Ratio Integer++instance Integral a => Q (Ratio a) where+ {-# SPECIALIZE instance Q Rational #-}+ type Z (Ratio a) = a+ {-# INLINE (%) #-}+ x % y = reduce (x * signum y) (abs y)+ where reduce x' y' = (x' `quot` d) :% (y' `quot` d) where d = gcd x' y'+ {-# INLINE (%!) #-}+ x %! y = x :% y+ {-# INLINE numerator #-}+ numerator (x :% _) = x+ {-# INLINE denominator #-}+ denominator (_ :% y) = y++instance Integral a => Ord (Ratio a) where+ {-# SPECIALIZE instance Ord Rational #-}+ (x:%y) <= (x':%y') = x * y' <= x' * y+ (x:%y) < (x':%y') = x * y' < x' * y++instance (Integral a, Read a) => Read (Ratio a) where+ readsPrec p = map (\(x,y) -> (toQ x, y)) . readsPrec p++instance (Integral a, Show a) => Show (Ratio a) where+ showsPrec p = showsPrec p . fromQ
− Fractal/RUFF/Types/Tuple.hs
@@ -1,23 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{- |-Module : Fractal.RUFF.Types.Tuple-Copyright : (c) Claude Heiland-Allen 2011-License : BSD3--Maintainer : claudiusmaximus@goto10.org-Stability : unstable-Portability : portable--Strict tuples.--}--module Fractal.RUFF.Types.Tuple- ( Tuple2(..)- ) where--import Data.Data (Data)-import Data.Typeable (Typeable)---- | Strict 'Tuple2' type.-data Tuple2 l r = Tuple2 !l !r- deriving (Read, Show, Eq, Ord, Data, Typeable)
ruff.cabal view
@@ -1,5 +1,5 @@ Name: ruff-Version: 0.3.2.1+Version: 0.4 Synopsis: relatively useful fractal functions Description: A library for analysis and exploration of fractals, providing@@ -11,8 +11,8 @@ License: BSD3 License-file: LICENSE Author: Claude Heiland-Allen-Maintainer: claudiusmaximus@goto10.org-Copyright: (c) 2011 Claude Heiland-Allen+Maintainer: claude@mathr.co.uk+Copyright: (c) 2011,2015 Claude Heiland-Allen Category: Math Build-type: Simple @@ -26,13 +26,15 @@ Fractal.RUFF.Mandelbrot.Nucleus Fractal.RUFF.Mandelbrot.Ray Fractal.RUFF.Types.Complex- Fractal.RUFF.Types.Tuple+ Fractal.RUFF.Types.Ratio Build-depends: base >= 3 && < 6, array >= 0.3 && < 0.6, mtl >= 2 && < 3, parsec >= 3.1 && < 3.2,+ safe >= 0.3.8 && < 0.4,+ strict >= 0.3.2 && < 0.4, Vec >= 1 && < 2- GHC-Options: -Wall -O2+ GHC-Options: -Wall GHC-Prof-Options: -prof -auto-all -caf-all source-repository head@@ -42,4 +44,4 @@ source-repository this type: git location: git://gitorious.org/ruff/ruff.git- tag: v0.3.2.1+ tag: v0.4