Hello!

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 балла)

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:         [email protected]
+author:             Vasily Vyalkov
+maintainer:         [email protected]
 
 -- 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

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

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

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

hw-quickcheck/test/Spec.hs

@@ -1,24 +1,37 @@
 {-# 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)
 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