~manuel-uberti/gpwh

3f0fdaaad06eddc66bd87f955aef74c5303914e4 — Manuel Uberti 4 months ago 10deda0 main
Add lesson 42
5 files changed, 90 insertions(+), 4 deletions(-)

M gpwh.cabal
M package.yaml
A src/lesson_42/qc.hs
A src/lesson_42/questions.hs
A src/lesson_42/uarray.hs
M gpwh.cabal => gpwh.cabal +1 -0
@@ 23,6 23,7 @@ library
      src
  build-depends:
      aeson
    , array
    , base >=4.7 && <5
    , bytestring
    , containers

M package.yaml => package.yaml +5 -4
@@ 18,16 18,17 @@ extra-source-files:
description:         Please see the README on SourceHut at <https://git.sr.ht/~manuel-uberti/gpwh/tree/main/item/README.md>

dependencies:
- aeson
- array
- base >= 4.7 && < 5
- bytestring
- containers
- random
- split
- text
- aeson
- http-conduit
- http-types
- random
- split
- sqlite-simple
- text
- time
  
library:

A src/lesson_42/qc.hs => src/lesson_42/qc.hs +22 -0
@@ 0,0 1,22 @@
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed

-- 42.1
qcArray :: UArray Int Bool
qcArray = array (0, 4) [(1, True), (2, True)]

-- 42.2
beansInBuckets :: UArray Int Int
beansInBuckets = array (0, 3) [(0, 0), (1, 0), (2, 0)]
-- beansInBuckets = array (0, 3) $ zip [0 .. 3] $ cycle [0]

-- 42.3
updatedBiB :: UArray Int Int
updatedBiB = accum (+) biB $ zip [0 .. 3] $ repeat 2
  where
    biB = beansInBuckets // [(1, 5), (3, 6)]

doubleBeans :: UArray Int Int
doubleBeans = accum (*) updatedBiB $ zip [0 .. 3] $ repeat 2

A src/lesson_42/questions.hs => src/lesson_42/questions.hs +31 -0
@@ 0,0 1,31 @@
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed

-- Q42.1
crossover :: (UArray Int Int, UArray Int Int) -> Int -> UArray Int Int
crossover (vals1, vals2) cutoff = runSTUArray $ do
  stArray1 <- thaw vals1
  let end = (snd . bounds) vals1
  forM_ [cutoff .. end] $ \i -> do
    let el = vals2 ! i
    writeArray stArray1 i el
  return stArray1

-- λ> crossover ((listArray (0, 4) [1,1,1,1,1]), (listArray (0, 4) [0,0,0,0,0])) 3
-- array (0,4) [(0,1),(1,1),(2,1),(3,0),(4,0)]  

-- Q42.2
replaceZeros :: UArray Int Int -> UArray Int Int
replaceZeros vals = runSTUArray $ do
  stArray <- thaw vals
  let end = (snd . bounds) vals
  forM_ [0 .. end] $ \i -> do
    val <- readArray stArray i
    when (val == 0) $ do
      writeArray stArray i (-1)
  return stArray

-- λ> replaceZeros (listArray (0, 10) [0, 1, 2, 0, 3, 4, 0, 0, 5, 6])
-- array (0,10) [(0,-1),(1,1),(2,2),(3,-1),(4,3),(5,4),(6,-1),(7,-1),(8,5),(9,6),(10,-1)]

A src/lesson_42/uarray.hs => src/lesson_42/uarray.hs +31 -0
@@ 0,0 1,31 @@
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed

listToUArray :: [Int] -> UArray Int Int
listToUArray vals = runSTUArray $ do
  let end = length vals - 1
  myArray <- newArray (0, end) 0
  forM_ [0 .. end] $ \i -> do
    let val = vals !! i
    writeArray myArray i val
  return myArray

myData :: UArray Int Int
myData = listArray (0, 5) [7, 6, 4, 8, 10, 2]
-- QC 42.4: listToUArray [7, 6, 4, 8, 10, 2]

bubbleSort :: UArray Int Int -> UArray Int Int
bubbleSort myArray = runSTUArray $ do
  stArray <- thaw myArray
  let end = (snd . bounds) myArray
  forM_ [1 .. end] $ \i -> do
    forM_ [0 .. (end - i)] $ \j -> do
      val <- readArray stArray j
      nextVal <- readArray stArray (j + 1)
      let outOfOrder = val > nextVal
      when outOfOrder $ do
        writeArray stArray j nextVal
        writeArray stArray (j + 1) val
  return stArray