feature-random #1

Merged
bombinans merged 6 commits from feature-random into main 2025-12-24 03:23:53 +00:00
2 changed files with 30 additions and 10 deletions
Showing only changes of commit fd489e1031 - Show all commits

View File

@ -1,5 +1,8 @@
module Main (main) where module Main (main) where
import System.Random
import Data.List
ordinals :: [ String ] ordinals :: [ String ]
ordinals = [ ordinals = [
"second", "second",
@ -87,10 +90,18 @@ 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
wrapGift :: ( Int, Int, Int, Int ) -> String
wrapGift (i, j, k, l) = gs !! l wrapGift :: ( Int, Int, Int ) -> [ String ]
where wrapGift (i, j, k) = map giftStr $ matchGifts (i, j, k)
gs = map giftStr $ matchGifts (i, j, k)
allGifts :: [ [ String ] ]
allGifts map wrapGift $ reverse signatures
tuples :: [ ( String, String ) ]
tuples = zip (reverse ordinals) allGifts
concatLines :: [ String ] -> String concatLines :: [ String ] -> String
concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls
@ -105,9 +116,6 @@ makeVerse :: String -> [ String ] -> String
makeVerse o [] = (opening o) ++ "A " ++ partridge makeVerse o [] = (opening o) ++ "A " ++ partridge
makeVerse o gs = (opening o) ++ (concatLines gs) ++ "And a " ++ partridge makeVerse o gs = (opening o) ++ (concatLines gs) ++ "And a " ++ partridge
allGifts :: [ String ]
allGifts = map wrapGift $ reverse signatures
recurseVerse :: [ ( String, String ) ] -> [ String ] recurseVerse :: [ ( String, String ) ] -> [ String ]
recurseVerse [] = [ makeVerse "first" [] ] recurseVerse [] = [ makeVerse "first" [] ]
recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts) recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
@ -115,9 +123,18 @@ recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
ord = fst t ord = fst t
gs = [(snd t)] ++ (map snd ts) gs = [(snd t)] ++ (map snd ts)
tuples :: [ ( String, String ) ]
tuples = zip (reverse ordinals) allGifts
randomOffsets :: StdGen -> [ String ]
randomOffsets gen gsets = map (\gs -> mod rs (length gs)) gsets
where rs = take (length gsets) . unfoldr (Just . random)
main :: IO () main :: IO ()
main = putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples main = do
gen <- newStdGen
let offsets = randomOffsets gen allGifts
print offsets
-- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples

View File

@ -35,6 +35,7 @@ library
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, random
default-language: Haskell2010 default-language: Haskell2010
executable xmasTwelve-exe executable xmasTwelve-exe
@ -48,6 +49,7 @@ executable xmasTwelve-exe
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, random
, xmasTwelve , xmasTwelve
default-language: Haskell2010 default-language: Haskell2010
@ -63,5 +65,6 @@ test-suite xmasTwelve-test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, random
, xmasTwelve , xmasTwelve
default-language: Haskell2010 default-language: Haskell2010