diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000..535fefc Binary files /dev/null and b/.DS_Store differ diff --git a/hw-quickcheck/.DS_Store b/hw-quickcheck/.DS_Store new file mode 100644 index 0000000..47030a6 Binary files /dev/null and b/hw-quickcheck/.DS_Store differ diff --git a/hw-quickcheck/README.md b/hw-quickcheck/README.md index 2dfd99d..7cbd4d3 100644 --- a/hw-quickcheck/README.md +++ b/hw-quickcheck/README.md @@ -2,7 +2,7 @@ | Выдано | Дедлайн | |:--------:|:---------------:| -| 25.01.23 | 23:59, 08.02.23 | +| 20.05.24 | 23:59, 27.05.24 | Первое домашнее задание по курсу; создано, чтобы @@ -64,18 +64,18 @@ hello Сделанные задачи можно помечать с помощью крестика: `- [x]` -- [ ] Вписать себя автором и мейнтейнером в `hw-quickcheck.cabal` (0 баллов) -- [ ] Объяснить поведение в `prop_minimum` (файл `test/Spec.hs`) (0.5 балла) -- [ ] Заполнить определение `Group` (файл `src/Data/Group.hs`) (0.5 балла) -- [ ] Сделать `GroupExpr` представителем класса `Group` +- [x] Вписать себя автором и мейнтейнером в `hw-quickcheck.cabal` (0 баллов) +- [x] Объяснить поведение в `prop_minimum` (файл `test/Spec.hs`) (0.5 балла) +- [x] Заполнить определение `Group` (файл `src/Data/Group.hs`) (0.5 балла) +- [x] Сделать `GroupExpr` представителем класса `Group` (файл `src/Data/GroupExpr.hs`) (1 балл) -- [ ] Реализовать вычисление выражения (1 балл) -- [ ] Сделать `GroupExpr` представителем класса `Monad` (1 балла) -- [ ] Проверять выражения на равенство с точностью до сокращений (2.5 балла) -- [ ] Компактное строковое представление для выражений (1 балл) +- [x] Реализовать вычисление выражения (1 балл) +- [x] Сделать `GroupExpr` представителем класса `Monad` (1 балла) +- [x] Проверять выражения на равенство с точностью до сокращений (2.5 балла) +- [x] Компактное строковое представление для выражений (1 балл) - [ ] Сделать `Var`, `GroupLit` и `GroupExpr` представителями класса `Arbitrary` (файл `test/Instances.hs`) (1 балл) -- [ ] Выписать аксиомы групп и проверить `GroupExpr` на соответствие +- [x] Выписать аксиомы групп и проверить `GroupExpr` на соответствие (файл `test/Spec.hs`) (1 балл) - [ ] Реализовать подстановку через `(>>=)` (файл `app/Main.hs`) (0.5 балла) - [ ] Реализовать взаимодействие с пользователем (2 балла) diff --git a/hw-quickcheck/hw-quickcheck.cabal b/hw-quickcheck/hw-quickcheck.cabal index d06241e..8571bae 100644 --- a/hw-quickcheck/hw-quickcheck.cabal +++ b/hw-quickcheck/hw-quickcheck.cabal @@ -13,8 +13,8 @@ version: 0.1.0.0 -- The license under which the package is released. -- license: -author: TurtlePU -maintainer: sokolov.p64@gmail.com +author: Vasily Vyalkov +maintainer: service@vyalkov.ru -- A copyright notice. -- copyright: @@ -29,7 +29,7 @@ executable hw-quickcheck -- LANGUAGE extensions used by modules in this package. -- other-extensions: - build-depends: hw-quickcheck, base ^>=4.14 + build-depends: hw-quickcheck, base ^>=4.16 hs-source-dirs: app default-language: Haskell2010 @@ -38,7 +38,7 @@ library Data.Group , Data.GroupExpr , Data.Var - build-depends: base ^>=4.14 + build-depends: base ^>=4.16 hs-source-dirs: src default-language: Haskell2010 @@ -48,7 +48,8 @@ test-suite hw-quickcheck-test other-modules: Instances build-depends: hw-quickcheck - , base ^>=4.14 + , base ^>=4.16 , QuickCheck ^>=2.14 + , bytestring ^>= 0.11.3.1 hs-source-dirs: test default-language: Haskell2010 diff --git a/hw-quickcheck/src/.DS_Store b/hw-quickcheck/src/.DS_Store new file mode 100644 index 0000000..e542607 Binary files /dev/null and b/hw-quickcheck/src/.DS_Store differ diff --git a/hw-quickcheck/src/Data/Group.hs b/hw-quickcheck/src/Data/Group.hs index fec9871..1b47165 100644 --- a/hw-quickcheck/src/Data/Group.hs +++ b/hw-quickcheck/src/Data/Group.hs @@ -10,8 +10,8 @@ class Monoid a => Group a where inverse :: a -> a -- ^ Group inverse. - inverse = error "TODO: `inverse`" + inverse a = mempty a () :: a -> a -> a -- ^ Group division. - x y = error "TODO: ``" + x y = x <> inverse y diff --git a/hw-quickcheck/src/Data/GroupExpr.hs b/hw-quickcheck/src/Data/GroupExpr.hs index 11bb5ac..e705293 100644 --- a/hw-quickcheck/src/Data/GroupExpr.hs +++ b/hw-quickcheck/src/Data/GroupExpr.hs @@ -1,8 +1,11 @@ {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE InstanceSigs #-} module Data.GroupExpr where import Data.Group (Group (..)) +import GHC.Num.BigNat (bigNatAdd) +import Data.List (singleton) -- | @GroupLit a@ is a type of literals in arbitrary group with -- variables ranging in @a@. @@ -14,6 +17,20 @@ data GroupLit a = Direct !a | Invert !a deriving (Show, Functor) -- (0 баллов) Реализуйте более естественное и компактное строковое -- представление для типа `GroupLit` вместо реализации по умолчанию. +instance Show a => Show (GroupLit a) where + show :: Show a => GroupLit a -> String + show (Direct a) = show a + show (Invert a) = show a ++ "'" + +instance Eq a => Eq (GroupLit a) where + (Direct a) == (Direct b) = a == b + (Invert a) == (Invert b) = a == b + _ == _ = False + +litInverse :: GroupLit a -> GroupLit a +litInverse (Direct a) = Invert a +litInverse (Invert a) = Direct a + -- | @GroupExpr a@ is a type of expressions in arbitrary group with -- variables ranging in @a@. -- @@ -25,11 +42,16 @@ newtype GroupExpr a = GroupExpr {getExpr :: [GroupLit a]} -- (1 балл) Сделайте `GroupExpr a` представителем класса `Group`. -- Можно пользоваться дерайвингом; никаких условий на `a` быть не должно. -instance Semigroup (GroupExpr a) +instance Semigroup (GroupExpr a) where + (GroupExpr x) <> (GroupExpr y) = GroupExpr (x ++ y) -instance Monoid (GroupExpr a) +instance Monoid (GroupExpr a) where + mempty = GroupExpr [] -instance Group (GroupExpr a) +instance Group (GroupExpr a) where + inverse (GroupExpr x) = GroupExpr ( + foldr (\head tail -> tail ++ [litInverse head]) [] x + ) -- (1 балл) Реализуйте вычисление выражения в группе. -- (0 баллов) Говоря терминами из алгебры, чем является `groupEval v`? @@ -42,21 +64,45 @@ groupEval :: GroupExpr x -> -- | Result of evaluation. g -groupEval = error "`groupEval` is not implemented" +groupEval subst (GroupExpr []) = mempty +groupEval subst (GroupExpr (Direct head: tail)) = subst head <> groupEval subst (GroupExpr tail) +groupEval subst (GroupExpr (Invert head: tail)) = inverse (subst head) <> groupEval subst (GroupExpr tail) + -- (1 балл) Сделайте `GroupExpr` представителем класса `Monad`. -- Подсказка: у (>>=) есть реализация в одну строчку. -instance Applicative GroupExpr +instance Applicative GroupExpr where + pure x = GroupExpr $ singleton $ Direct x -instance Monad GroupExpr +instance Monad GroupExpr where + (>>=) :: GroupExpr a -> (a -> GroupExpr b) -> GroupExpr b + expr >>= func = groupEval func expr -- (2.5 балла) Реализуйте проверку выражений на равенство с точностью до -- сокращений: -- `GroupExpr [Direct 'y', Direct 'x', Invert 'x'] == GroupExpr [Direct 'y']` -- должно возвращать True. -instance Eq a => Eq (GroupExpr a) +simplifyInternal :: Eq a => [GroupLit a] -> [GroupLit a] -> [GroupLit a] +simplifyInternal [] (rhv_h: rhv_t) = simplifyInternal [rhv_h] rhv_t +simplifyInternal lhv [] = reverse lhv +simplifyInternal lhv@(lhv_h:lhv_t) (rhv_h:rhv_t) + | lhv_h == litInverse rhv_h = simplifyInternal [] (reverse lhv_t ++ rhv_t) + | otherwise = simplifyInternal (rhv_h : lhv) rhv_t + +simplify (GroupExpr x) = GroupExpr $ simplifyInternal [] x +instance Eq a => Eq (GroupExpr a) where + a == b = let compare a b = length (getExpr a) == length (getExpr b) && + all (uncurry (==)) (zip (getExpr a) (getExpr b)) + in compare (simplify a) (simplify b) -- (1 балл) Реализуйте более естественное и компактное строковое представление -- для типа `GroupExpr a` вместо реализации по умолчанию. + +instance Show a => Show (GroupExpr a) where + show (GroupExpr []) = "1" + show (GroupExpr expr) = let showInternal x = case x of + [] -> "" + (head: tail) -> show head ++ showInternal tail + in showInternal expr \ No newline at end of file diff --git a/hw-quickcheck/src/Data/Var.hs b/hw-quickcheck/src/Data/Var.hs index b5e7e4a..9608496 100644 --- a/hw-quickcheck/src/Data/Var.hs +++ b/hw-quickcheck/src/Data/Var.hs @@ -5,3 +5,5 @@ newtype Var = Var Char deriving (Eq) instance Show Var where show (Var x) = pure x + +-- Here was Vasya diff --git a/hw-quickcheck/test/Spec.hs b/hw-quickcheck/test/Spec.hs index a2991db..eada6cb 100644 --- a/hw-quickcheck/test/Spec.hs +++ b/hw-quickcheck/test/Spec.hs @@ -1,7 +1,9 @@ {-# LANGUAGE TemplateHaskell #-} import Control.Monad (unless) -import Data.GroupExpr (GroupExpr) +import Data.List (intercalate) +import Data.Group +import Data.GroupExpr (GroupExpr (GroupExpr), simplify) import Data.Var (Var) import Instances import System.Exit (exitFailure) @@ -9,16 +11,27 @@ import Test.QuickCheck -- (0 баллов) Выполняется ли свойство `prop_minimum`? Проверьте. -- (0.5 балла) Объясните. +-- minimum возвращает всегда один элемент котрежа, т.к только один и видит +-- кортеж интерпретируется как последовательность из одного +-- элемента, т.е как элемент и его контекст. prop_minimum = minimum(100, 500) === 500 -- (1 балл) Выпишите аксиомы групп в виде свойств QuickCheck и проверьте, что -- они выполняются для Вашей реализации `GroupExpr`. +prop_assoc :: GroupExpr Var -> GroupExpr Var -> GroupExpr Var -> Property +prop_assoc a b c = a <> (b <> c) === (a <> b) <> c + +prop_neutral :: GroupExpr Var -> Property +prop_neutral a = a <> mempty === a .&&. mempty <> a === a + +prop_inverse :: GroupExpr Var -> Property +prop_inverse a = a <> inverse a === mempty .&&. inverse a <> a === mempty type TestExpr = GroupExpr Var return [] main = do - success <- $quickCheckAll + success <- $verboseCheckAll unless success exitFailure