Halfway through refactoring for random offsets

This commit is contained in:
Mike Lynch 2025-12-24 13:49:06 +11:00
parent fd489e1031
commit 3d80a6847d
2 changed files with 30 additions and 22 deletions

View File

@ -18,21 +18,24 @@ ordinals = [
"twelfth" "twelfth"
] ]
signatures :: [ ( Int, Int, Int, Int) ] signatures :: [ ( Int, Int, Int) ]
signatures = [ signatures = [
( 3, 6, 5, 0 ), ( 3, 6, 5 ),
( 5, 6, 4, 1 ), ( 5, 6, 4 ),
( 4, 7, 5, 1 ), ( 4, 7, 5 ),
( 4, 4, 5, 5 ), ( 4, 4, 5 ),
( 3, 5, 8, 8 ), ( 3, 5, 8 ),
( 5, 5, 10, 5 ), ( 5, 5, 10 ),
( 5, 5, 9, 20 ), ( 5, 5, 9 ),
( 4, 6, 7, 10 ), ( 4, 6, 7 ),
( 3, 5, 9, 23 ), ( 3, 5, 9 ),
( 6, 6, 6, 3 ), ( 6, 6, 6 ),
( 6, 8, 8, 3 ) ( 6, 8, 8 )
] ]
offsets :: [ Int ]
offsets = [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ]
cardinals :: [ String ] cardinals :: [ String ]
cardinals = [ cardinals = [
"Two", "Two",
@ -90,17 +93,17 @@ matchGifts ( i, j, k ) = filter match gifts
giftStr :: ( String, String, String ) -> String giftStr :: ( String, String, String ) -> String
giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b
wrapGifts :: ( Int, Int, Int ) -> [ String ]
wrapGift :: ( Int, Int, Int ) -> [ String ] wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k)
wrapGift (i, j, k) = map giftStr $ matchGifts (i, j, k)
allGifts :: [ [ String ] ] allGifts :: [ [ String ] ]
allGifts map wrapGift $ reverse signatures allGifts = map wrapGifts $ reverse signatures
tuples :: [ ( String, String ) ] -- tuples :: [ ( String, String ) ]
tuples = zip (reverse ordinals) allGifts -- tuples = zip (reverse ordinals) allGifts
concatLines :: [ String ] -> String concatLines :: [ String ] -> String
@ -125,16 +128,20 @@ recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
randomOffsets :: StdGen -> [ String ] randomOffsets :: StdGen -> [ [ String ] ] -> [ Int ]
randomOffsets gen gsets = map (\gs -> mod rs (length gs)) gsets randomOffsets gen gsets = map (\t -> mod (fst t) (length (snd t))) ts
where rs = take (length gsets) . unfoldr (Just . random) where rs = randomInts gen (length gsets)
ts = zip rs gsets
randomInts :: StdGen -> Int -> [ Int ]
randomInts gen n = take n $ randoms gen
main :: IO () main :: IO ()
main = do main = do
gen <- newStdGen gen <- newStdGen
let offsets = randomOffsets gen allGifts let offsets = randomOffsets gen allGifts
print offsets print offsets
print allGifts
-- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples -- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples

View File

@ -21,6 +21,7 @@ description: Please see the README on GitHub at <https://github.com/gith
dependencies: dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- random
ghc-options: ghc-options:
- -Wall - -Wall