├── .gitignore ├── Abelian.hs ├── Core.hs ├── Dummy.hs ├── Field.hs ├── Group.hs ├── LICENSE ├── Monoid.hs ├── README.md ├── Ring.hs ├── Semigroup.hs ├── Setup.hs ├── package.yaml └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Created by https://www.gitignore.io/api/haskell 3 | 4 | ### Haskell ### 5 | dist 6 | dist-* 7 | cabal-dev 8 | *.o 9 | *.hi 10 | *.chi 11 | *.chs.h 12 | *.dyn_o 13 | *.dyn_hi 14 | .hpc 15 | .hsenv 16 | .cabal-sandbox/ 17 | cabal.sandbox.config 18 | *.prof 19 | *.aux 20 | *.hp 21 | *.eventlog 22 | .stack-work/ 23 | cabal.project.local 24 | cabal.project.local~ 25 | .HTF/ 26 | .ghc.environment.* 27 | 28 | 29 | # End of https://www.gitignore.io/api/haskell 30 | algebra-with-nico-code.cabal 31 | -------------------------------------------------------------------------------- /Abelian.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | module Abelian where 4 | 5 | import Core 6 | import Prelude hiding (Semigroup(..)) 7 | import Semigroup 8 | import Test.SmallCheck (smallCheck) 9 | 10 | -- #@@range_begin(class) 11 | class Semigroup a => Abelian a 12 | -- #@@range_end(class) 13 | 14 | -- #@@range_begin(instances) 15 | instance Abelian Sum 16 | instance Abelian Product 17 | instance Abelian RSum 18 | instance Abelian RProduct 19 | instance Abelian And 20 | instance Abelian Or 21 | instance Abelian Xor 22 | instance Abelian () 23 | -- #@@range_end(instances) 24 | 25 | -- #@@range_begin(law) 26 | commutativeLaw :: (Abelian a, Eq a) => a -> a -> Bool 27 | commutativeLaw x y = 28 | x <> y == y <> x 29 | -- #@@range_end(law) 30 | 31 | -- #@@range_begin(tests_for_law) 32 | main :: IO () 33 | main = do 34 | smallCheck 2 $ commutativeLaw @Sum 35 | smallCheck 2 $ commutativeLaw @Product 36 | smallCheck 2 $ commutativeLaw @RSum 37 | smallCheck 2 $ commutativeLaw @RProduct 38 | smallCheck 2 $ commutativeLaw @And 39 | smallCheck 2 $ commutativeLaw @Or 40 | smallCheck 2 $ commutativeLaw @Xor 41 | smallCheck 2 $ commutativeLaw @() 42 | -- #@@range_end(tests_for_law) 43 | -------------------------------------------------------------------------------- /Core.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE InstanceSigs #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | -- | Expose pricipal data with the instances 8 | module Core where 9 | 10 | import Data.Ratio ((%)) 11 | import Test.SmallCheck.Series (Serial(..), Series) 12 | 13 | -- #@@range_begin(wrapper_types) 14 | newtype Sum = Sum 15 | { unSum :: Integer 16 | } deriving (Show, Eq, Num, Enum) 17 | 18 | newtype Product = Product 19 | { unProduct :: Integer 20 | } deriving (Show, Eq, Num, Enum) 21 | 22 | newtype RSum = RSum 23 | { unRSum :: Rational 24 | } deriving (Show, Eq, Num, Enum) 25 | 26 | newtype RProduct = RProduct 27 | { unRProduct :: Rational 28 | } deriving (Show, Eq, Num, Enum) 29 | 30 | newtype And = And 31 | { unAnd :: Bool 32 | } deriving (Show, Eq) 33 | 34 | newtype Or = Or 35 | { unOr :: Bool 36 | } deriving (Show, Eq) 37 | 38 | xor :: Bool -> Bool -> Bool 39 | xor True True = False 40 | xor True False = True 41 | xor False True = True 42 | xor False False = False 43 | 44 | newtype Xor = Xor 45 | { unXor :: Bool 46 | } deriving (Show, Eq) 47 | -- #@@range_end(wrapper_types) 48 | 49 | instance Monad m => Serial m Sum where 50 | series :: Series m Sum 51 | series = Sum <$> series 52 | 53 | instance Monad m => Serial m Product where 54 | series :: Series m Product 55 | series = Product <$> series 56 | 57 | instance Monad m => Serial m RSum where 58 | series :: Series m RSum 59 | series = RSum <$> series 60 | 61 | instance Monad m => Serial m RProduct where 62 | series :: Series m RProduct 63 | series = RProduct <$> series 64 | 65 | instance Monad m => Serial m And where 66 | series :: Series m And 67 | series = And <$> series 68 | 69 | instance Monad m => Serial m Or where 70 | series :: Series m Or 71 | series = Or <$> series 72 | 73 | instance Monad m => Serial m Xor where 74 | series :: Series m Xor 75 | series = Xor <$> series 76 | -------------------------------------------------------------------------------- /Dummy.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "dummy" 3 | -------------------------------------------------------------------------------- /Field.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | {-# LANGUAGE TypeSynonymInstances #-} 6 | 7 | module Field 8 | ( Field (..) 9 | ) where 10 | 11 | import Data.Ratio ((%), numerator, denominator) 12 | import Prelude hiding ((<>)) 13 | import Ring 14 | import Test.SmallCheck (smallCheck) 15 | 16 | -- #@@range_begin(class) 17 | class Ring a => Field a where 18 | inverseM :: a -> a 19 | -- #@@range_end(class) 20 | 21 | -- #@@range_begin(instances) 22 | instance Field Rational where 23 | inverseM x = denominator x % numerator x 24 | -- #@@range_end(instances) 25 | 26 | -- #@@range_begin(laws) 27 | inverseLawForMulti :: (Field a, Eq a) => a -> Bool 28 | inverseLawForMulti x 29 | | x == emptyA = True 30 | | otherwise = 31 | (x >< inverseM x == emptyM) && (emptyM == inverseM x >< x) 32 | 33 | emptyDifferenceLaw :: forall a. (Field a, Eq a) => Bool 34 | emptyDifferenceLaw = (emptyM :: a) /= (emptyA :: a) 35 | -- #@@range_end(laws) 36 | 37 | main :: IO () 38 | main = do 39 | smallCheck 2 $ inverseLawForMulti @Rational 40 | smallCheck 2 $ emptyDifferenceLaw @Rational 41 | -------------------------------------------------------------------------------- /Group.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | module Group 6 | ( Group (..) 7 | ) where 8 | 9 | import Core 10 | import Data.Ratio ((%), numerator, denominator) 11 | import Monoid 12 | import Prelude hiding (Semigroup(..), Monoid(..)) 13 | import Semigroup 14 | import Test.SmallCheck (smallCheck) 15 | 16 | -- #@@range_begin(class) 17 | class Monoid a => Group a where 18 | inverse :: a -> a 19 | -- #@@range_end(class) 20 | 21 | -- #@@range_begin(instances) 22 | instance Group Sum where 23 | inverse = negate 24 | 25 | instance Group RSum where 26 | inverse = negate 27 | 28 | instance Group Xor where 29 | inverse = id 30 | 31 | instance Group () where 32 | inverse () = () 33 | -- #@@range_end(instances) 34 | 35 | -- #@@range_begin(law) 36 | inverseLaw :: (Group a, Eq a) => a -> Bool 37 | inverseLaw x = 38 | (x <> inverse x == empty) && (empty == inverse x <> x) 39 | -- #@@range_end(law) 40 | 41 | main :: IO () 42 | main = do 43 | smallCheck 2 $ inverseLaw @Sum 44 | smallCheck 2 $ inverseLaw @RSum 45 | smallCheck 2 $ inverseLaw @Xor 46 | smallCheck 2 $ inverseLaw @() 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2018 aiya000 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /Monoid.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | module Monoid 4 | ( Monoid (..) 5 | ) where 6 | 7 | import Core 8 | import Data.Ratio ((%)) 9 | import Prelude hiding (Semigroup(..), Monoid(..)) 10 | import Semigroup 11 | import Test.SmallCheck (smallCheck) 12 | 13 | -- #@@range_begin(class) 14 | class Semigroup a => Monoid a where 15 | empty :: a 16 | -- #@@range_end(class) 17 | 18 | -- #@@range_begin(instances) 19 | instance Monoid Sum where 20 | empty = Sum 0 21 | 22 | instance Monoid Product where 23 | empty = Product 1 24 | 25 | instance Monoid RSum where 26 | empty = RSum $ 0 % 1 27 | 28 | instance Monoid RProduct where 29 | empty = RProduct $ 1 % 1 30 | 31 | instance Monoid [a] where 32 | empty = [] 33 | 34 | instance Monoid And where 35 | empty = And True 36 | 37 | instance Monoid Or where 38 | empty = Or False 39 | 40 | instance Monoid Xor where 41 | empty = Xor False 42 | 43 | instance Monoid () where 44 | empty = () 45 | -- #@@range_end(instances) 46 | 47 | -- #@@range_begin(law) 48 | emptyLaw :: (Monoid a, Eq a) => a -> Bool 49 | emptyLaw x = 50 | (empty <> x == x) && (x == x <> empty) 51 | -- #@@range_end(law) 52 | 53 | -- #@@range_begin(practice) 54 | mconcat :: Monoid a => [a] -> a 55 | mconcat = foldl (<>) empty 56 | 57 | resultSum :: Sum 58 | resultSum = mconcat [1..100] 59 | 60 | resultAll :: And 61 | resultAll = mconcat [And True, And True, And True] 62 | -- #@@range_end(practice) 63 | 64 | main :: IO () 65 | main = do 66 | smallCheck 2 $ emptyLaw @Sum 67 | smallCheck 2 $ emptyLaw @Product 68 | smallCheck 2 $ emptyLaw @RSum 69 | smallCheck 2 $ emptyLaw @RProduct 70 | smallCheck 2 $ emptyLaw @[Double] 71 | smallCheck 2 $ emptyLaw @And 72 | smallCheck 2 $ emptyLaw @Or 73 | smallCheck 2 $ emptyLaw @Xor 74 | smallCheck 2 $ emptyLaw @() 75 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # algebra-with-nico-code 2 | The example codes for 矢澤にこ先輩と一緒に代数！ 3 | -------------------------------------------------------------------------------- /Ring.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | {-# LANGUAGE TypeSynonymInstances #-} 4 | 5 | module Ring 6 | ( Ring (..) 7 | ) where 8 | 9 | import Core (xor) 10 | import Data.Ratio ((%)) 11 | import Prelude hiding ((<>)) 12 | import Test.SmallCheck (smallCheck) 13 | 14 | -- #@@range_begin(class) 15 | class Ring a where 16 | (<>) :: a -> a -> a 17 | emptyA :: a 18 | inverseA :: a -> a 19 | (><) :: a -> a -> a 20 | emptyM :: a 21 | 22 | infixl 6 <> 23 | infixl 7 >< 24 | -- #@@range_end(class) 25 | 26 | -- #@@range_begin(instances) 27 | instance Ring Integer where 28 | (<>) = (+) 29 | emptyA = 0 30 | inverseA = negate 31 | (><) = (*) 32 | emptyM = 1 33 | 34 | instance Ring Rational where 35 | (<>) = (+) 36 | emptyA = 0 % 1 37 | inverseA = negate 38 | (><) = (*) 39 | emptyM = 1 % 1 40 | 41 | instance Ring Bool where 42 | (<>) = xor 43 | emptyA = False 44 | inverseA = id 45 | (><) = (&&) 46 | emptyM = True 47 | 48 | instance Ring () where 49 | () <> () = () 50 | emptyA = () 51 | inverseA () = () 52 | () >< () = () 53 | emptyM = () 54 | -- #@@range_end(instances) 55 | 56 | -- #@@range_begin(laws) 57 | -- #@@range_begin(additive_laws) 58 | associativeLawForAdd :: (Ring a, Eq a) => a -> a -> a -> Bool 59 | associativeLawForAdd x y z = 60 | (x <> y) <> z == x <> (y <> z) 61 | 62 | commutativeLawForAdd :: (Ring a, Eq a) => a -> a -> Bool 63 | commutativeLawForAdd x y = 64 | x <> y == y <> x 65 | 66 | emptyLawForAdd :: (Ring a, Eq a) => a -> Bool 67 | emptyLawForAdd x = 68 | (x <> emptyA == x) && (x == emptyA <> x) 69 | 70 | inverseLawForAdd :: (Ring a, Eq a) => a -> Bool 71 | inverseLawForAdd x = 72 | (x <> inverseA x == emptyA) && (emptyA == inverseA x <> x) 73 | -- #@@range_end(additive_laws) 74 | 75 | -- #@@range_begin(multiplicative_laws) 76 | associativeLawForMulti :: (Ring a, Eq a) => a -> a -> a -> Bool 77 | associativeLawForMulti x y z = 78 | (x >< y) >< z == x >< (y >< z) 79 | 80 | commutativeLawForMulti :: (Ring a, Eq a) => a -> a -> Bool 81 | commutativeLawForMulti x y = 82 | x <> y == y <> x 83 | 84 | emptyLawForMulti :: (Ring a, Eq a) => a -> Bool 85 | emptyLawForMulti x = 86 | (x >< emptyM == x) && (x == emptyM >< x) 87 | -- #@@range_end(multiplicative_laws) 88 | 89 | -- #@@range_begin(distributive_law) 90 | distributiveLaw :: (Ring a, Eq a) => a -> a -> a -> Bool 91 | distributiveLaw x y z = 92 | x >< (y <> z) == x >< y <> x >< z 93 | && 94 | (y <> z) >< x == y >< x <> z >< x 95 | -- #@@range_end(distributive_law) 96 | -- #@@range_end(laws) 97 | 98 | checkAdditiveLaws :: IO () 99 | checkAdditiveLaws = do 100 | smallCheck 2 $ associativeLawForAdd @Integer 101 | smallCheck 2 $ associativeLawForAdd @Rational 102 | smallCheck 2 $ associativeLawForAdd @Bool 103 | smallCheck 2 $ associativeLawForAdd @() 104 | smallCheck 2 $ commutativeLawForAdd @Integer 105 | smallCheck 2 $ commutativeLawForAdd @Rational 106 | smallCheck 2 $ commutativeLawForAdd @Bool 107 | smallCheck 2 $ commutativeLawForAdd @() 108 | smallCheck 2 $ emptyLawForAdd @Integer 109 | smallCheck 2 $ emptyLawForAdd @Rational 110 | smallCheck 2 $ emptyLawForAdd @Bool 111 | smallCheck 2 $ emptyLawForAdd @() 112 | smallCheck 2 $ inverseLawForAdd @Integer 113 | smallCheck 2 $ inverseLawForAdd @Rational 114 | smallCheck 2 $ inverseLawForAdd @Bool 115 | smallCheck 2 $ inverseLawForAdd @() 116 | 117 | checkMultiplicativeLaws :: IO () 118 | checkMultiplicativeLaws = do 119 | smallCheck 2 $ associativeLawForMulti @Integer 120 | smallCheck 2 $ associativeLawForMulti @Rational 121 | smallCheck 2 $ associativeLawForMulti @Bool 122 | smallCheck 2 $ associativeLawForMulti @() 123 | smallCheck 2 $ commutativeLawForMulti @Integer 124 | smallCheck 2 $ commutativeLawForMulti @Rational 125 | smallCheck 2 $ commutativeLawForMulti @Bool 126 | smallCheck 2 $ commutativeLawForMulti @() 127 | smallCheck 2 $ emptyLawForMulti @Integer 128 | smallCheck 2 $ emptyLawForMulti @Rational 129 | smallCheck 2 $ emptyLawForMulti @Bool 130 | smallCheck 2 $ emptyLawForMulti @() 131 | 132 | checkDistributiveLaw :: IO () 133 | checkDistributiveLaw = do 134 | smallCheck 2 $ distributiveLaw @Integer 135 | smallCheck 2 $ distributiveLaw @Rational 136 | smallCheck 2 $ distributiveLaw @Bool 137 | smallCheck 2 $ distributiveLaw @() 138 | 139 | main :: IO () 140 | main = do 141 | checkAdditiveLaws 142 | checkMultiplicativeLaws 143 | checkDistributiveLaw 144 | -------------------------------------------------------------------------------- /Semigroup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | {-# LANGUAGE TypeSynonymInstances #-} 4 | 5 | module Semigroup 6 | ( Semigroup (..) 7 | , Sum (..) 8 | , Product (..) 9 | , And (..) 10 | , Or (..) 11 | ) where 12 | 13 | import Prelude hiding (Semigroup(..), concat) 14 | import Core 15 | import Test.SmallCheck (smallCheck) 16 | 17 | -- #@@range_begin(class) 18 | class Semigroup a where 19 | (<>) :: a -> a -> a 20 | -- #@@range_end(class) 21 | 22 | -- #@@range_begin(int_instance) 23 | instance Semigroup Integer where 24 | (<>) = (+) 25 | -- #@@range_end(int_instance) 26 | 27 | -- #@@range_begin(bool_instance) 28 | instance Semigroup Bool where 29 | (<>) = (&&) 30 | -- #@@range_end(bool_instance) 31 | 32 | -- #@@range_begin(newtype_instances) 33 | instance Semigroup Sum where 34 | (<>) = (+) 35 | 36 | instance Semigroup Product where 37 | (<>) = (*) 38 | 39 | instance Semigroup And where 40 | And x <> And y = And $ x && y 41 | 42 | instance Semigroup Or where 43 | Or x <> Or y = Or $ x || y 44 | 45 | instance Semigroup Xor where 46 | Xor x <> Xor y = Xor $ x `xor` y 47 | -- #@@range_end(newtype_instances) 48 | 49 | -- #@@range_begin(another_instances) 50 | instance Semigroup RSum where 51 | (<>) = (+) 52 | 53 | instance Semigroup RProduct where 54 | (<>) = (*) 55 | 56 | instance Semigroup [a] where 57 | (<>) = (++) 58 | 59 | instance Semigroup () where 60 | () <> () = () 61 | -- #@@range_end(another_instances) 62 | 63 | -- #@@range_begin(int_instances_examples) 64 | aSumInt :: Sum 65 | aSumInt = Sum 10 <> Sum 20 66 | 67 | aProductInt :: Product 68 | aProductInt = Product 10 <> Product 20 69 | -- #@@range_end(int_instances_examples) 70 | 71 | -- #@@range_begin(law) 72 | -- #@@range_begin(law_type) 73 | associativeLaw :: (Semigroup a, Eq a) => a -> a -> a -> Bool 74 | -- #@@range_end(law_type) 75 | associativeLaw x y z = 76 | (x <> y) <> z == x <> (y <> z) 77 | -- #@@range_end(law) 78 | 79 | -- #@@range_begin(practice) 80 | concat :: Semigroup a => a -> [a] -> a 81 | concat = foldl (<>) 82 | 83 | resultSum :: Integer 84 | resultSum = concat 0 [1..100] 85 | 86 | resultAll :: Bool 87 | resultAll = concat True [True, True, True] 88 | -- #@@range_end(practice) 89 | 90 | -- #@@range_begin(tests_for_law) 91 | main :: IO () 92 | main = do 93 | smallCheck 2 $ associativeLaw @Sum 94 | smallCheck 2 $ associativeLaw @Product 95 | smallCheck 2 $ associativeLaw @RSum 96 | smallCheck 2 $ associativeLaw @RProduct 97 | smallCheck 2 $ associativeLaw @[Double] 98 | smallCheck 2 $ associativeLaw @And 99 | smallCheck 2 $ associativeLaw @Or 100 | smallCheck 2 $ associativeLaw @Xor 101 | smallCheck 2 $ associativeLaw @() 102 | -- #@@range_end(tests_for_law) 103 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: algebra-with-nico-code 2 | version: '0.1.0.0' 3 | category: Simple 4 | author: aiya000 5 | maintainer: aiya000.develop@gmail.com 6 | copyright: 2018 aiya000 7 | license: MIT 8 | homepage: https://github.com/aiya000/algebra-with-nico-code 9 | 10 | dependencies: 11 | - base >=4.7 && <5 12 | - smallcheck 13 | 14 | executables: 15 | dummy: 16 | main: Dummy.hs 17 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-12.5 2 | packages: 3 | - . 4 | allow-different-user: true 5 | --------------------------------------------------------------------------------