implemented setRung

This commit is contained in:
Jonathan Lamothe 2024-08-21 14:34:46 -04:00
parent 768497d399
commit e52bee47c3
2 changed files with 43 additions and 3 deletions

View File

@ -30,6 +30,7 @@ module Abacus (
getNumBeads,
getNumRungs,
getRung,
setRung,
) where
import Data.List (find)
@ -68,4 +69,26 @@ getRung r a = snd <$> find
(\(n, _) -> n == r)
(zip [0..] $ abacusRungs a)
-- | Sets the number of beads slid across a given rung
setRung
:: Int
-- ^ The rung number
-> Int
-- ^ The value being set
-> Abacus
-- ^ The original state
-> Abacus
-- ^ The new state
setRung r v a = a
{ abacusRungs = zipWith
(\n x -> if n == r then v' else x)
[0..]
(abacusRungs a)
}
where
v'
| v < 0 = 0
| v > getNumBeads a = getNumBeads a
| otherwise = v
--jl

View File

@ -33,6 +33,7 @@ spec = describe "Abacus" $ do
getNumBeadsSpec
getNumRungsSpec
getRungSpec
setRungSpec
newAbacusSpec :: Spec
newAbacusSpec = describe "newAbacusSpec" $ mapM_
@ -81,11 +82,27 @@ getRungSpec = describe "getRung" $ mapM_
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "0th rung", 0, Just 2 )
[ ( "first rung", 0, Just 2 )
, ( "last rung", 2, Just 5 )
, ( "negative rung", -1, Nothing )
, ( "too large", 3, Nothing )
] where
abacus = Abacus 10 [2, 3, 5]
setRungSpec :: Spec
setRungSpec = describe "setRung" $ mapM_
( \(desc, rung, val, expected) -> context desc $ let
actual = setRung rung val $ mkA [2, 3, 5]
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "first rung", 0, 10, mkA [10, 3, 5] )
, ( "last rung", 2, 10, mkA [ 2, 3, 10] )
, ( "negative rung", -1, 10, mkA [ 2, 3, 5] )
, ( "large rung", 3, 10, mkA [ 2, 3, 5] )
, ( "negative value", 1, -1, mkA [ 2, 0, 5] )
, ( "large value", 1, 11, mkA [ 2, 10, 5] )
] where
mkA = Abacus 10
--jl