universe 0.1 → 0.2
raw patch · 2 files changed
+56/−25 lines, 2 files
Files
- Data/Universe.hs +54/−23
- universe.cabal +2/−2
Data/Universe.hs view
@@ -72,9 +72,27 @@ instance Universe a => Universe (Last a) where universe = map Last universe -- see http://mathlesstraveled.com/2008/01/07/recounting-the-rationals-part-ii-fractions-grow-on-trees/--- TODO: since we know these numerators and denominators are always going to be--- in reduced terms, we could use (:%) when we know we're compiling with GHC to--- get a small speed boost+--+-- also, Brent Yorgey writes:+--+-- positiveRationals2 :: [Ratio Integer]+-- positiveRationals2 = iterate' next 1+-- where+-- next x = let (n,y) = properFraction x in recip (fromInteger n + 1 - y)+-- iterate' f x = let x' = f x in x' `seq` (x : iterate' f x')+--+-- Compiling this code with -O2 and doing some informal tests seems to+-- show that positiveRationals and positiveRationals2 have almost exactly+-- the same efficiency for generating the entire list (e.g. the times for+-- finding the sum of the first 100000 rationals are pretty much+-- indistinguishable). positiveRationals is still the clear winner for+-- generating just the nth rational for some particular n -- some simple+-- experiments seem to indicate that doing this with positiveRationals2+-- scales linearly while with positiveRationals it scales sub-linearly,+-- as expected.+--+-- Surprisingly, replacing % with :% in positiveRationals seems to make+-- no appreciable difference. positiveRationals :: [Ratio Integer] positiveRationals = 1 : map lChild positiveRationals +++ map rChild positiveRationals where lChild frac = numerator frac % (numerator frac + denominator frac)@@ -90,32 +108,28 @@ tableToFunction = (!) . fromList . zip monoUniverse monoUniverse = universeF --- instances for Representable functors; in general we want--- instance (Finite (Key f), Ord (Key f), Universe a, Representable f)--- => Universe (f a)--- where universe = map tabulate universe--- but this has ridiculous overlap, so we expand this for each of the--- instantiations of f that are Representable instead+instance Universe a => Universe (Identity a) where universe = map Identity universe+instance Universe (f a) => Universe (IdentityT f a) where universe = map IdentityT universe+instance (Finite e, Ord e, Universe (m a)) => Universe (ReaderT e m a) where universe = map ReaderT universe+instance Universe (f (g a)) => Universe (Compose f g a) where universe = map Compose universe+instance (Universe (f a), Universe (g a)) => Universe (Functor.Product f g a) where universe = [Functor.Pair f g | (f, g) <- universe +*+ universe] -instance Universe a => Universe (Identity a) where universe = map Identity universe-instance (Representable f, Finite (Key f), Ord (Key f), Universe a)- => Universe (IdentityT f a)- where universe = map tabulate universe+-- We could do this:+--+-- instance Universe (f a) => Universe (Rep f a) where universe = map Rep universe+--+-- However, since you probably only apply Rep to functors when you want to+-- think of them as being representable, I think it makes sense to use an+-- instance based on the representable-ness rather than the inherent+-- universe-ness.+--+-- Please complain if you disagree! instance (Representable f, Finite (Key f), Ord (Key f), Universe a) => Universe (Rep f a) where universe = map tabulate universe instance (Representable f, Finite s, Ord s, Finite (Key f), Ord (Key f), Universe a) => Universe (TracedT s f a) where universe = map tabulate universe-instance (Representable f, Finite e, Ord e, Finite (Key f), Ord (Key f), Universe a)- => Universe (ReaderT e f a)- where universe = map tabulate universe-instance (Representable f, Representable g, Finite (Key f), Ord (Key f), Finite (Key g), Ord (Key g), Universe a)- => Universe (Compose f g a)- where universe = map tabulate universe-instance (Representable f, Representable g, Finite (Key f), Ord (Key f), Finite (Key g), Ord (Key g), Universe a)- => Universe (Functor.Product f g a)- where universe = map tabulate universe instance Finite () instance Finite Bool@@ -148,7 +162,24 @@ instance Finite a => Finite (First a) where universeF = map First universeF instance Finite a => Finite (Last a) where universeF = map Last universeF -instance (Ord a, Finite a, Finite b) => Finite (a -> b)+instance (Ord a, Finite a, Finite b) => Finite (a -> b) where+ universeF = map tableToFunction tables where+ tables = sequence [universeF | _ <- monoUniverse]+ tableToFunction = (!) . fromList . zip monoUniverse+ monoUniverse = universeF++instance Finite a => Finite (Identity a) where universeF = map Identity universeF+instance Finite (f a) => Finite (IdentityT f a) where universeF = map IdentityT universeF+instance (Finite e, Ord e, Finite (m a)) => Finite (ReaderT e m a) where universeF = map ReaderT universeF+instance Finite (f (g a)) => Finite (Compose f g a) where universeF = map Compose universeF+instance (Finite (f a), Finite (g a)) => Finite (Functor.Product f g a) where universeF = liftM2 Functor.Pair universeF universeF++instance (Representable f, Finite (Key f), Ord (Key f), Finite a)+ => Finite (Rep f a)+ where universeF = map tabulate universeF+instance (Representable f, Finite s, Ord s, Finite (Key f), Ord (Key f), Finite a)+ => Finite (TracedT s f a)+ where universeF = map tabulate universeF -- to add as people ask for them: -- instance (Eq a, Finite a) => Finite (Endo a) (+Universe)
universe.cabal view
@@ -1,5 +1,5 @@ name: universe-version: 0.1+version: 0.2 synopsis: Classes for types where we know all the values description: A small package, in the spirit of data-default, which allows the munging of finite and recursively enumerable types license: BSD3@@ -16,7 +16,7 @@ source-repository this type: git location: https://github.com/dmwit/universe- tag: 0.1+ tag: 0.2 library exposed-modules: Data.Universe,