diff --git a/Fractal/RUFF/Mandelbrot/Address.hs b/Fractal/RUFF/Mandelbrot/Address.hs --- a/Fractal/RUFF/Mandelbrot/Address.hs +++ b/Fractal/RUFF/Mandelbrot/Address.hs @@ -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)/ -. + and +/Rational parameter rays of the Mandelbrot set (version of August 11, 1998)/ +. -} 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 diff --git a/Fractal/RUFF/Mandelbrot/Atom.hs b/Fractal/RUFF/Mandelbrot/Atom.hs --- a/Fractal/RUFF/Mandelbrot/Atom.hs +++ b/Fractal/RUFF/Mandelbrot/Atom.hs @@ -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 diff --git a/Fractal/RUFF/Mandelbrot/Image.hs b/Fractal/RUFF/Mandelbrot/Image.hs --- a/Fractal/RUFF/Mandelbrot/Image.hs +++ b/Fractal/RUFF/Mandelbrot/Image.hs @@ -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 diff --git a/Fractal/RUFF/Mandelbrot/Iterate.hs b/Fractal/RUFF/Mandelbrot/Iterate.hs --- a/Fractal/RUFF/Mandelbrot/Iterate.hs +++ b/Fractal/RUFF/Mandelbrot/Iterate.hs @@ -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 diff --git a/Fractal/RUFF/Mandelbrot/Nucleus.hs b/Fractal/RUFF/Mandelbrot/Nucleus.hs --- a/Fractal/RUFF/Mandelbrot/Nucleus.hs +++ b/Fractal/RUFF/Mandelbrot/Nucleus.hs @@ -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/ -- . -- -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 -- . -- -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/ -- . -- -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] diff --git a/Fractal/RUFF/Mandelbrot/Ray.hs b/Fractal/RUFF/Mandelbrot/Ray.hs --- a/Fractal/RUFF/Mandelbrot/Ray.hs +++ b/Fractal/RUFF/Mandelbrot/Ray.hs @@ -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/ -- . -- -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 diff --git a/Fractal/RUFF/Types/Complex.hs b/Fractal/RUFF/Types/Complex.hs --- a/Fractal/RUFF/Types/Complex.hs +++ b/Fractal/RUFF/Types/Complex.hs @@ -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 diff --git a/Fractal/RUFF/Types/Ratio.hs b/Fractal/RUFF/Types/Ratio.hs new file mode 100644 --- /dev/null +++ b/Fractal/RUFF/Types/Ratio.hs @@ -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 diff --git a/Fractal/RUFF/Types/Tuple.hs b/Fractal/RUFF/Types/Tuple.hs deleted file mode 100644 --- a/Fractal/RUFF/Types/Tuple.hs +++ /dev/null @@ -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) diff --git a/ruff.cabal b/ruff.cabal --- a/ruff.cabal +++ b/ruff.cabal @@ -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