From d5b507805840985559b50c54f40fcebbf60ef749 Mon Sep 17 00:00:00 2001 From: Vasily Vyalkov Date: Mon, 27 May 2024 21:57:02 +0300 Subject: [PATCH 1/2] A part of a long journey --- .DS_Store | Bin 0 -> 8196 bytes hw-quickcheck/.DS_Store | Bin 0 -> 6148 bytes hw-quickcheck/README.md | 18 ++++----- hw-quickcheck/hw-quickcheck.cabal | 11 ++--- hw-quickcheck/src/.DS_Store | Bin 0 -> 6148 bytes hw-quickcheck/src/Data/Group.hs | 4 +- hw-quickcheck/src/Data/GroupExpr.hs | 60 ++++++++++++++++++++++++---- hw-quickcheck/src/Data/Var.hs | 2 + hw-quickcheck/test/Spec.hs | 17 +++++++- 9 files changed, 87 insertions(+), 25 deletions(-) create mode 100644 .DS_Store create mode 100644 hw-quickcheck/.DS_Store create mode 100644 hw-quickcheck/src/.DS_Store diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..535fefc4f8caf1058bcddc4191fe2f53c1261226 GIT binary patch literal 8196 zcmeHMK~EDw6n+D(-9kV@)NnD`#4BKlfCn$7z=1?PP@@MmxXV`9blI)ltrZETM~(l% zzu?WE;(zg^-Lr>y~d|Q`;<{y(zX{Y1C{~HfMvikU>Udy4B*V>;#_drB?J6? za8X${wHzraA02393IJKbWm(Wi9w0HUmQ5{3N=hhfs_a2%sL&~fP;iX9tPa`Ka-^h! zlTdIHdS;`+k)880Rgufx7%t z7W9bf1zl(26p1Wz+Nw5Q+VCS{2m>dXvyT49Ft}A zd$8J*9Q8|RW;KtV!rVi7#}}@hWHyhP(U><_H@?3v>LI*EZw%9ai1dePPshtQzZZpR z)@Xbe6O)zdwVG3Nrk$7V!(`abyljxRy#90k_9RIn|E%x%Ps7e|Z|=rs5@%i*clr_# z1|6upcoxP%GHfM-I7lV7tp=RBQ{S7rb#l^Jbk|lIr;F~%{k8Q)clF-t>1o}$dFSqf z-Mwyf6el0S9E#8f2+gSP=j|u-e#6Y$c0Z1inAe^yaJ(?@Db`7?bbvmy*rCi|kz*~- zVg)hk0X;6R@_IFTNISGi+w_>)v|Y5yaU^DQaWs!u<4ET{vn1os2D zJ)2O$bI4(o$_Oo<&YC4)3HGFv&(!m5{_E zguFXTvRIZqIm_Z)&blHZF{@h-9_7*@9*xly`7gki$&9Y{OrZ6lfij< zk;%^*xxk5}?19lM`GSgB%co$Pr84`79*%xUV=C!6UDAva8qzs@Oe0n6pbRO3r!`LB zka?3+lTPT64yaGZ&<g_H2L+R_rR1eOUj zbhE|x|KXqC|I10XWeHdUD@8y!{h;5&lFZ$DYjJ$ndhic$Hjb;bsuUFFI#w0Fil4%j ZVa($S)HhmbMGwsW2q+A;umt`of!{Mu{jdN4 literal 0 HcmV?d00001 diff --git a/hw-quickcheck/README.md b/hw-quickcheck/README.md index 2dfd99d..784b87a 100644 --- a/hw-quickcheck/README.md +++ b/hw-quickcheck/README.md @@ -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 0000000000000000000000000000000000000000..e542607c35e3588ef081c6f8a04ce5638d289f6d GIT binary patch literal 6148 zcmeHK%}T>S5Z-O0O(;SRDjow~i>BD>!Ap$w;MIs8RBB?124l9gsX3HFj`~7Aim#(H zyPJZ4Cqbml!0fk~o!KzohMf#!jQf+g&6v#?GeHq+77X7AuA_dDnzqydIqq?sikm1E z5j^9DB>$fQJUfH+Sjch~emcJcSlfD&A`_YWMa6ii&-o=9rpY*W-B(_#8%xU#vtc&P ztKd!)K_2Flu^)~u@aa^DG^*xdbe0T?zP)-VvOG+(!AJ%q@c>*d&yy?`g)b&qJeIM6 zS}-ls>f7tnsoQe8ZFkmkrhDDpmebkk%x0Fkwz<83(!Wn1GV!E{=kQfZS+w{osHidKycG^6G#=wg7+z zn5Dp6{`vztXaMvymI}cF!c{1s3gx=R;JS0*Dje25?O!TX;f%{S!#?`WTz4p3Hy+%P z?u>g1X(R@SfsYJe?+0RI{XhD-|CdfQ5Cg=(Vlu#uUeNO)H(gu5WQn!b0lfxALBCSr lJOn1P6oW68;tfzKV0Ul==xHn!f(3+r1SAbK5Ceb8z&r6^Q^EiM literal 0 HcmV?d00001 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 From 175d57cf90affbcf8c544ce2cb0ca9c9455b132f Mon Sep 17 00:00:00 2001 From: Vasily Vyalkov Date: Mon, 27 May 2024 22:00:06 +0300 Subject: [PATCH 2/2] One more thing --- hw-quickcheck/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hw-quickcheck/README.md b/hw-quickcheck/README.md index 784b87a..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 | Первое домашнее задание по курсу; создано, чтобы