newsynth 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+87/−39 lines, 7 files

Files

• ChangeLog +10/−0
• Quantum/Synthesis/EuclideanDomain.hs +14/−1
• Quantum/Synthesis/LaTeX.hs +1/−1
• Quantum/Synthesis/Newsynth.hs +10/−4
• Quantum/Synthesis/Ring.hs +42/−31
• Quantum/Synthesis/Ring/FixedPrec.hs +5/−0
• newsynth.cabal +5/−2

@@ -1,5 +1,15 @@ ChangeLog +v0.1.1.0 2014/02/05+	(2014/02/04) PS1 - new functions euclid_divides and euclid_associates.+	(2014/02/04) PS1 - changed 'lobit' and improved its asymptotic+	efficiency.+	(2014/02/04) PS1 - fixed a bug in the ShowLaTeX instance of Rational.+	(2014/02/04) PS1 - added profiling options.+	(2014/02/03) PS1 - eliminated common subexpressions in gridpoints.+	(2014/02/03) PS1 - made fromDyadic an operation of the HalfRing+	class, and improved its efficiency.+ v0.1.0.0 2013/12/14 	(2013/12/13) PS1 - added new rings DComplex and QComplex. 	Improvements to the ring QOmega.

@@ -73,7 +73,8 @@ -- ---------------------------------------------------------------------- -- ** Functions --- | Calculate the remainder for the division of /x/ by /y/.+-- | Calculate the remainder for the division of /x/ by /y/. Assumes+-- that /y/ ≠ 0. euclid_mod :: (EuclideanDomain a) => a -> a -> a euclid_mod x y = r where   (q,r) = x `divmod` y@@ -83,6 +84,7 @@ -- | Calculate the quotient for the division of /x/ by /y/, ignoring -- the remainder, if any. This is typically, but not always, used in -- situations where the remainder is known to be 0 ahead of time.+-- Assumes that /y/ ≠ 0. euclid_div :: (EuclideanDomain a) => a -> a -> a euclid_div x y = q where   (q,r) = x `divmod` y@@ -136,6 +138,17 @@   Nothing -> Nothing   where     (b,_,_,_,d) = extended_euclid a p++-- | Check whether /a/ is a divisor of /b/.+euclid_divides :: (EuclideanDomain a) => a -> a -> Bool+euclid_divides 0 0 = True+euclid_divides 0 b = False+euclid_divides a b = b `euclid_mod` a == 0++-- | Check whether /a/ and /b/ are associates, i.e., differ at most by+-- a multiplicative unit.+euclid_associates :: (EuclideanDomain a) => a -> a -> Bool+euclid_associates a b = (a `euclid_divides` b) && (b `euclid_divides` a)  -- ---------------------------------------------------------------------- -- * Auxiliary functions

@@ -87,7 +87,7 @@   showlatex r = "\\frac{" ++ showlatex num ++ "}{" ++ showlatex denom ++ "}"     where       num = numerator r-      denom = numerator r+      denom = denominator r  instance ShowLaTeX Dyadic where   showlatex = showlatex . toRational

@@ -200,13 +200,13 @@   | dy <= 0 && dx > 0 =          map adj2 $ gridpoints (y0, y1) (x0, x1)   | dy >= lambda && even n =-        map (lambdainv^n *) $ gridpoints (lambda^n*x0, lambda^n*x1) (lambda'^n*y0, lambda'^n*y1)+        map (lambdainv_n *) $ gridpoints (lambda_n*x0, lambda_n*x1) (lambda'_n*y0, lambda'_n*y1)   | dy >= lambda && odd n =-        map (lambdainv^n *) $ gridpoints (lambda^n*x0, lambda^n*x1) (lambda'^n*y1, lambda'^n*y0)+        map (lambdainv_n *) $ gridpoints (lambda_n*x0, lambda_n*x1) (lambda'_n*y1, lambda'_n*y0)   | dy > 0 && dy < 1 && even n = -        map (lambda^m *) $ gridpoints (lambdainv^m*x0, lambdainv^m*x1) (lambdainv'^m*y0, lambdainv'^m*y1)+        map (lambda_m *) $ gridpoints (lambdainv_m*x0, lambdainv_m*x1) (lambdainv'_m*y0, lambdainv'_m*y1)   | dy > 0 && dy < 1 && odd n = -        map (lambda^m *) $ gridpoints (lambdainv^m*x0, lambdainv^m*x1) (lambdainv'^m*y1, lambdainv'^m*y0)+        map (lambda_m *) $ gridpoints (lambdainv_m*x0, lambdainv_m*x1) (lambdainv'_m*y1, lambdainv'_m*y0)   | otherwise =         [ RootTwo a b | a <- [amin..amax], b <- [bmin a..bmax a], test a b ]    where@@ -223,6 +223,12 @@     lambdainv = -1 + roottwo     lambdainv' :: (RootTwoRing r) => r     lambdainv' = -1 - roottwo+    lambda_m = lambda^m+    lambda_n = lambda^n+    lambda'_n = lambda'^n+    lambdainv_m = lambdainv^m+    lambdainv'_m = lambdainv'^m+    lambdainv_n = lambdainv^n      within x (x0, x1) = x0 <= x && x <= x1     amin = ceiling_of ((x0 + y0) / 2)

@@ -43,9 +43,24 @@ -- ** Rings with ½  -- | A type class for rings that contain ½.+-- +-- Minimal complete definition: 'half'. The default definition of+-- 'fromDyadic' uses the expression @a*half^n@. However, this can give+-- potentially bad round-off errors for fixed-precision types where+-- the expression @half^n@ can underflow. For such rings, one should+-- provide a custom definition, for example by using @a/2^n@ instead. class (Ring a) => HalfRing a where   -- | The value ½.   half :: a+  +  -- | The unique ring homomorphism from ℤ[½] to any 'HalfRing'. This+  -- exists because ℤ[½] is the free 'HalfRing'.+  fromDyadic :: Dyadic -> a+  fromDyadic x +    | n >= 0    = fromInteger a * half^n+    | otherwise = fromInteger a * 2^(-n)+    where+      (a,n) = decompose_dyadic x  instance HalfRing Double where   half = 0.5@@ -58,6 +73,7 @@  instance (HalfRing a, RealFloat a) => HalfRing (Complex a) where   half = half :+ 0+  fromDyadic x = fromDyadic x :+ 0  -- ---------------------------------------------------------------------- -- ** Rings with √2@@ -274,10 +290,10 @@ decompose_dyadic :: Dyadic -> (Integer, Integer) decompose_dyadic (Dyadic a n)    | a == 0 = (0, 0)-  | n >= k = (b, n-k)-  | otherwise = (shiftL b (fromInteger (k-n)), 0)+  | n >= k = (a `shiftR` fromInteger k, n-k)+  | otherwise = (a `shiftR` fromInteger n, 0)   where-    (b,k) = lobit a+    k = lobit a  -- | Given a dyadic fraction /r/ and an integer /k/≥0, such that /a/ = -- /r/2[sup /k/] is an integer, return /a/. If /a/ is not an integer,@@ -317,6 +333,7 @@  instance HalfRing Dyadic where   half = Dyadic 1 1+  fromDyadic = id  instance Adjoint Dyadic where   adj x = x@@ -324,21 +341,6 @@ instance Adjoint2 Dyadic where   adj2 x = x --- | The unique ring homomorphism from ℤ[½] to any ring containing--- ½. This exists because ℤ[½] is the free such ring.---- Implementation note: we can't just use fromInteger a * half^n,--- because this can give potentially bad round-off errors in case--- half^n underflows in the target type. Moreover, this does not work--- if n is negative.-fromDyadic :: (HalfRing a) => Dyadic -> a-fromDyadic x = aux (fromInteger a) n where-  (a,n) = decompose_dyadic x-  aux !a !n-    | n>0       = aux (half*a) (n-1)-    | n==0      = a-    | otherwise = aux (2*a) (n+1)- -- ---------------------------------------------------------------------- -- ** The ring ℚ of rational numbers @@ -423,6 +425,7 @@  instance (Eq a, HalfRing a) => HalfRing (RootTwo a) where   half = RootTwo half 0+  fromDyadic x = RootTwo (fromDyadic x) 0    instance (Eq a, HalfRing a) => RootHalfRing (RootTwo a) where   roothalf = RootTwo 0 half@@ -532,6 +535,7 @@  instance (HalfRing a) => HalfRing (Cplx a) where   half = Cplx half 0+  fromDyadic x = Cplx (fromDyadic x) 0  instance (RootHalfRing a) => RootHalfRing (Cplx a) where   roothalf = Cplx roothalf 0@@ -671,6 +675,7 @@  instance (HalfRing a) => HalfRing (Omega a) where   half = Omega 0 0 0 half+  fromDyadic x = Omega 0 0 0 (fromDyadic x)  instance (HalfRing a) => RootHalfRing (Omega a) where   roothalf = Omega (-half) 0 half 0@@ -1011,25 +1016,31 @@ -- ---------------------------------------------------------------------- -- * Auxiliary functions --- | If /n/≠0, return (/a/,/k/) such that /a/ is odd and /n/ =--- /a/⋅2[sup /k/]. If /n/=0, return (/0/,/0/).-lobit :: Integer -> (Integer, Integer)-lobit 0 = (0,0)-lobit n = aux n 0 where-  aux n !k-    | n .&. 0xffffffff == 0  = aux (shiftR n 32) (k+32)-    | n .&. 0xff == 0        = aux (shiftR n 8) (k+8)-    | even n                 = aux (shiftR n 1) (k+1)-    | otherwise              = (n,k)-        +-- | Return the position of the rightmost \"1\" bit of an Integer, or+-- -1 if none. Do this in time O(/n/ log /n/), where /n/ is the size+-- of the integer (in digits).+lobit :: Integer -> Integer+lobit 0 = -1+lobit n = aux 1 where+  aux k+    | n .&. (2^k-1) == 0 = aux (2*k)+    | otherwise = aux2 k (k `div` 2)+  aux2 upper lower+    | upper - lower < 2 = lower+    | n .&. (2^middle-1) == 0 = aux2 upper middle+    | otherwise = aux2 middle lower+    where+      middle = (upper + lower) `div` 2+ -- | If /n/ is of the form 2[sup /k/], return /k/. Otherwise, return -- 'Nothing'. log2 :: Integer -> Maybe Integer log2 n-  | a == 1 = Just k+  | n <= 0 = Nothing+  | n == 2^k = Just k   | otherwise = Nothing     where-      (a,k) = lobit n+      k = lobit n  -- | For /n/ ≥ 0, return the floor of the square root of /n/. This is -- done using integer arithmetic, so there are no rounding errors.

@@ -14,6 +14,11 @@  instance Precision e => HalfRing (FixedPrec e) where   half = 0.5+  fromDyadic x+    | n >= 0    = fromInteger a / 2^n+    | otherwise = fromInteger a * 2^n+    where+      (a,n) = decompose_dyadic x  instance Precision e => Adjoint (FixedPrec e) where   adj x = x

@@ -7,7 +7,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.0+version:             0.1.1.0  -- A short (one-line) description of the package. synopsis:            Exact and approximate synthesis of quantum circuits@@ -60,7 +60,7 @@ maintainer:          selinger@mathstat.dal.ca  -- A copyright notice.-copyright:           Copyright (c) 2012-2013 Peter Selinger+copyright:           Copyright (c) 2012-2014 Peter Selinger  -- A classification category for future use by the package catalogue -- Hackage. These categories have not yet been specified, but the@@ -87,6 +87,9 @@   -- Other library packages from which modules are imported.   build-depends:       base ==4.6.*, random ==1.0.*, fixedprec ==0.2.*, superdoc ==0.1.* +  -- Additional options for GHC when the package is built with+  -- profiling enabled.+  ghc-prof-options:    -prof -auto-all  executable newsynth   -- .hs or .lhs file containing the Main module.