poly (empty) → 0.1.0.0

raw patch · 8 files changed

+267/−0 lines, 8 filesdep +QuickCheckdep +basedep +polysetup-changed

Dependencies added: QuickCheck, base, poly, quickcheck-classes, semirings, tasty, tasty-quickcheck, vector

Files

LICENSE +30/−0
README.md +3/−0
Setup.hs +2/−0
changelog.md +3/−0
poly.cabal +51/−0
src/Data/Poly.hs +14/−0
src/Data/Poly/Uni/Dense.hs +130/−0
test/Main.hs +34/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Andrew Lelechenko (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Lelechenko nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,3 @@+# poly++A type to represent polynomials with Num and Semiring instances.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ changelog.md view

@@ -0,0 +1,3 @@+# 0.1.0.0++* Initial release.

+ poly.cabal view

@@ -0,0 +1,51 @@+name: poly+version: 0.1.0.0+synopsis: Polynomials+description:+  A type to represent polynomials with Num and Semiring instances.+homepage: https://github.com/Bodigrim/poly#readme+license: BSD3+license-file: LICENSE+author: Andrew Lelechenko+maintainer: andrew.lelechenko@gmail.com+copyright: 2019 Andrew Lelechenko+category: Math, Numerical+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+tested-with: GHC ==7.10.3 GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.4+extra-source-files:+  changelog.md++source-repository head+  type: git+  location: https://github.com/Bodigrim/poly++library+  hs-source-dirs: src+  exposed-modules:+    Data.Poly+  other-modules:+    Data.Poly.Uni.Dense+  build-depends:+    base >= 4.8 && < 5,+    semirings,+    vector+  default-language: Haskell2010+  ghc-options: -Wall++test-suite poly-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  build-depends:+    base >=4.8 && <5,+    poly,+    QuickCheck >=2.10,+    quickcheck-classes >=0.6.1,+    semirings,+    tasty,+    tasty-quickcheck,+    vector+  default-language: Haskell2010+  hs-source-dirs: test+  ghc-options: -Wall

+ src/Data/Poly.hs view

@@ -0,0 +1,14 @@+-- |+-- Module:      Data.Poly+-- Copyright:   (c) 2019 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Polynomials.+--++module Data.Poly+  ( module Data.Poly.Uni.Dense+  ) where++import Data.Poly.Uni.Dense

+ src/Data/Poly/Uni/Dense.hs view

@@ -0,0 +1,130 @@+-- |+-- Module:      Data.Poly.Uni.Dense+-- Copyright:   (c) 2019 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Dense polynomials of one variable.+--++{-# LANGUAGE ScopedTypeVariables #-}++module Data.Poly.Uni.Dense+  ( Poly+  , unPoly+  , toPoly+  , toPoly'+  ) where++import Prelude hiding (negate)+import Control.Monad+import Control.Monad.ST+import Data.List (foldl')+import Data.Semiring (Semiring(..), Ring(..))+import Data.Vector (Vector)+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV++-- | Polynomials of one variable.+--+-- >>> :set -XOverloadedLists+-- >>> -- (1 + x) * (-1 + x) = (-1 + x^2)+-- >>> toPoly [1,1] * toPoly [-1,1]+-- Poly {unPoly = [-1,0,1]}+--+-- >>> :set -XOverloadedLists+-- >>> -- (1 + x) + (1 - x) = 2+-- >>> toPoly [1,1] + toPoly [1,-1]+-- Poly {unPoly = [2]}+newtype Poly a = Poly+  { unPoly :: Vector a+  -- ^ Convert 'Poly' to a vector of coefficients+  -- (first element corresponds to a constant term).+  }+  deriving (Eq, Ord, Show)++-- | Make 'Poly' from a list of coefficients+-- (first element corresponds to a constant term).+--+-- >>> :set -XOverloadedLists+-- >>> toPoly [1,2,3]+-- Poly {unPoly = [1,2,3]}+--+-- >>> :set -XOverloadedLists+-- >>> toPoly [0,0,0]+-- Poly {unPoly = []}+toPoly :: (Eq a, Num a) => Vector a -> Poly a+toPoly = Poly . dropWhileEnd (== 0)++-- | Make 'Poly' from a vector of coefficients+-- (first element corresponds to a constant term).+--+-- >>> :set -XOverloadedLists+-- >>> toPoly' [1,2,3]+-- Poly {unPoly = [1,2,3]}+--+-- >>> :set -XOverloadedLists+-- >>> toPoly' [0,0,0]+-- Poly {unPoly = []}+toPoly' :: (Eq a, Semiring a) => Vector a -> Poly a+toPoly' = Poly . dropWhileEnd (== zero)++instance (Eq a, Num a) => Num (Poly a) where+  Poly xs + Poly ys = toPoly $ zipOrCopy (+) xs ys+  Poly xs - Poly ys = toPoly $ zipOrCopy (-) xs ys+  abs = id+  signum = const 1+  fromInteger n = case fromInteger n of+    0 -> Poly $ V.empty+    m -> Poly $ V.singleton m+  Poly xs * Poly ys = toPoly $ convolution 0 (+) (*) xs ys++instance (Eq a, Semiring a) => Semiring (Poly a) where+  zero = Poly V.empty+  one+    | (one :: a) == zero = zero+    | otherwise = Poly $ V.singleton one+  plus (Poly xs) (Poly ys) = toPoly' $ zipOrCopy plus xs ys+  times (Poly xs) (Poly ys) = toPoly' $ convolution zero plus times xs ys++instance (Eq a, Ring a) => Ring (Poly a) where+  negate (Poly xs) = Poly $ V.map negate xs++dropWhileEnd :: (a -> Bool) -> Vector a -> Vector a+dropWhileEnd p xs = V.slice 0 (go (V.length xs)) xs+  where+    go 0 = 0+    go n = if p (xs V.! (n - 1)) then go (n - 1) else n++zipOrCopy :: (a -> a -> a) -> Vector a -> Vector a -> Vector a+zipOrCopy f xs ys = runST $ do+  zs <- MV.new lenZs+  forM_ [0 .. lenZs - 1] $ \i ->+    MV.write zs i (f (xs V.! i) (ys V.! i))+  when (lenXs < lenYs) $+    forM_ [lenXs .. lenYs - 1] $ \i ->+      MV.write zs i (ys V.! i)+  when (lenYs < lenXs) $+    forM_ [lenYs .. lenXs - 1] $ \i ->+      MV.write zs i (xs V.! i)+  V.unsafeFreeze zs+  where+    lenXs = V.length xs+    lenYs = V.length ys+    lenZs = lenXs `max` lenYs++convolution :: a -> (a -> a -> a) -> (a -> a -> a) -> Vector a -> Vector a -> Vector a+convolution zer add mul xs ys+  | V.null xs || V.null ys = V.empty+  | otherwise = runST $ do+    zs <- MV.new lenZs+    forM_ [0 .. lenZs - 1] $ \k -> do+      let is = [max (k - lenYs + 1) 0 .. min k (lenXs - 1)]+          -- js = reverse [max (k - lenXs) 0 .. min k lenYs]+      let acc = foldl' add zer $ flip map is $ \i -> mul (xs V.! i) (ys V.! (k - i))+      MV.write zs k acc+    V.unsafeFreeze zs+  where+    lenXs = V.length xs+    lenYs = V.length ys+    lenZs = lenXs + lenYs - 1

+ test/Main.hs view

@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main where++import Data.Int+import Data.Poly+import Data.Proxy+import Data.Semiring+import qualified Data.Vector as V+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck.Classes++main :: IO ()+main = defaultMain $ testGroup "All"+    [ semiringTests+    ]++semiringTests :: TestTree+semiringTests+  = testGroup "Semiring"+  $ map (uncurry testProperty)+  $ concatMap lawsProperties+  [ semiringLaws (Proxy :: Proxy (Poly ()))+  ,     ringLaws (Proxy :: Proxy (Poly ()))+  , semiringLaws (Proxy :: Proxy (Poly Int8))+  ,     ringLaws (Proxy :: Proxy (Poly Int8))+  , semiringLaws (Proxy :: Proxy (Poly Integer))+  ,     ringLaws (Proxy :: Proxy (Poly Integer))+  ]++instance (Eq a, Semiring a, Arbitrary a) => Arbitrary (Poly a) where+  arbitrary = toPoly' . V.fromList <$> arbitrary+  shrink = fmap (toPoly' . V.fromList) . shrink . V.toList . unPoly