From fd489e10319da90eb6ad0618771c962584a843b9 Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Tue, 23 Dec 2025 16:43:23 +1100 Subject: [PATCH 1/6] Trying to get it to compile with System.Random --- app/Main.hs | 37 +++++++++++++++++++++++++++---------- xmasTwelve.cabal | 3 +++ 2 files changed, 30 insertions(+), 10 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index d6eab66..fa94acb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,8 @@ module Main (main) where +import System.Random +import Data.List + ordinals :: [ String ] ordinals = [ "second", @@ -87,10 +90,18 @@ matchGifts ( i, j, k ) = filter match gifts giftStr :: ( String, String, String ) -> String giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b -wrapGift :: ( Int, Int, Int, Int ) -> String -wrapGift (i, j, k, l) = gs !! l - where - gs = map giftStr $ matchGifts (i, j, k) + +wrapGift :: ( Int, Int, Int ) -> [ String ] +wrapGift (i, j, k) = 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 ls = foldr (\a b -> a ++ "\n" ++ b) "" ls @@ -105,9 +116,6 @@ makeVerse :: String -> [ String ] -> String makeVerse o [] = (opening o) ++ "A " ++ partridge makeVerse o gs = (opening o) ++ (concatLines gs) ++ "And a " ++ partridge -allGifts :: [ String ] -allGifts = map wrapGift $ reverse signatures - recurseVerse :: [ ( String, String ) ] -> [ String ] recurseVerse [] = [ makeVerse "first" [] ] recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts) @@ -115,9 +123,18 @@ recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts) ord = fst t 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 = 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 diff --git a/xmasTwelve.cabal b/xmasTwelve.cabal index 3fccdb0..c80d862 100644 --- a/xmasTwelve.cabal +++ b/xmasTwelve.cabal @@ -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 build-depends: base >=4.7 && <5 + , random default-language: Haskell2010 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 build-depends: base >=4.7 && <5 + , random , xmasTwelve 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 build-depends: base >=4.7 && <5 + , random , xmasTwelve default-language: Haskell2010 From 3d80a6847d8946387c5fbc8586656fe632ac3d1a Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Wed, 24 Dec 2025 13:49:06 +1100 Subject: [PATCH 2/6] Halfway through refactoring for random offsets --- app/Main.hs | 51 +++++++++++++++++++++++++++++---------------------- package.yaml | 1 + 2 files changed, 30 insertions(+), 22 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index fa94acb..cb95b3a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -18,21 +18,24 @@ ordinals = [ "twelfth" ] -signatures :: [ ( Int, Int, Int, Int) ] +signatures :: [ ( Int, Int, Int) ] signatures = [ - ( 3, 6, 5, 0 ), - ( 5, 6, 4, 1 ), - ( 4, 7, 5, 1 ), - ( 4, 4, 5, 5 ), - ( 3, 5, 8, 8 ), - ( 5, 5, 10, 5 ), - ( 5, 5, 9, 20 ), - ( 4, 6, 7, 10 ), - ( 3, 5, 9, 23 ), - ( 6, 6, 6, 3 ), - ( 6, 8, 8, 3 ) + ( 3, 6, 5 ), + ( 5, 6, 4 ), + ( 4, 7, 5 ), + ( 4, 4, 5 ), + ( 3, 5, 8 ), + ( 5, 5, 10 ), + ( 5, 5, 9 ), + ( 4, 6, 7 ), + ( 3, 5, 9 ), + ( 6, 6, 6 ), + ( 6, 8, 8 ) ] +offsets :: [ Int ] +offsets = [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ] + cardinals :: [ String ] cardinals = [ "Two", @@ -90,17 +93,17 @@ matchGifts ( i, j, k ) = filter match gifts giftStr :: ( String, String, String ) -> String giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b - -wrapGift :: ( Int, Int, Int ) -> [ String ] -wrapGift (i, j, k) = map giftStr $ matchGifts (i, j, k) - +wrapGifts :: ( Int, Int, Int ) -> [ String ] +wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k) allGifts :: [ [ String ] ] -allGifts map wrapGift $ reverse signatures +allGifts = map wrapGifts $ reverse signatures + + -tuples :: [ ( String, String ) ] -tuples = zip (reverse ordinals) allGifts +-- tuples :: [ ( String, String ) ] +-- tuples = zip (reverse ordinals) allGifts concatLines :: [ String ] -> String @@ -125,16 +128,20 @@ recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts) -randomOffsets :: StdGen -> [ String ] -randomOffsets gen gsets = map (\gs -> mod rs (length gs)) gsets - where rs = take (length gsets) . unfoldr (Just . random) +randomOffsets :: StdGen -> [ [ String ] ] -> [ Int ] +randomOffsets gen gsets = map (\t -> mod (fst t) (length (snd t))) ts + where rs = randomInts gen (length gsets) + ts = zip rs gsets +randomInts :: StdGen -> Int -> [ Int ] +randomInts gen n = take n $ randoms gen main :: IO () main = do gen <- newStdGen let offsets = randomOffsets gen allGifts print offsets + print allGifts -- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples diff --git a/package.yaml b/package.yaml index d3c27b9..d0716ba 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,7 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- random ghc-options: - -Wall From e0cd78f64eb60bf040609ee30f84fda64b44317e Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Wed, 24 Dec 2025 14:02:59 +1100 Subject: [PATCH 3/6] Randomised version works --- app/Main.hs | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index cb95b3a..ecb01e9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,6 @@ module Main (main) where import System.Random -import Data.List ordinals :: [ String ] ordinals = [ @@ -99,12 +98,9 @@ wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k) allGifts :: [ [ String ] ] allGifts = map wrapGifts $ reverse signatures - - - --- tuples :: [ ( String, String ) ] --- tuples = zip (reverse ordinals) allGifts - +selectGifts :: [ Int ] -> [ String ] +selectGifts os = map (\t -> (fst t) !! (snd t)) ts + where ts = zip allGifts os concatLines :: [ String ] -> String concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls @@ -139,9 +135,9 @@ randomInts gen n = take n $ randoms gen main :: IO () main = do gen <- newStdGen - let offsets = randomOffsets gen allGifts - print offsets - print allGifts - - --- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples + let roffsets = randomOffsets gen allGifts + print roffsets + print (selectGifts roffsets) + print (selectGifts $ reverse offsets) + let tuples = zip ordinals $ selectGifts roffsets + putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples From ac9ce4d959848b118713fe150e14780f68b07990 Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Wed, 24 Dec 2025 14:11:31 +1100 Subject: [PATCH 4/6] Command-line flag to make the output random --- app/Main.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index ecb01e9..20acac2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,7 @@ module Main (main) where import System.Random +import System.Environment ordinals :: [ String ] ordinals = [ @@ -33,7 +34,7 @@ signatures = [ ] offsets :: [ Int ] -offsets = [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ] +offsets = reverse [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ] cardinals :: [ String ] cardinals = [ @@ -136,8 +137,7 @@ main :: IO () main = do gen <- newStdGen let roffsets = randomOffsets gen allGifts - print roffsets - print (selectGifts roffsets) - print (selectGifts $ reverse offsets) - let tuples = zip ordinals $ selectGifts roffsets + args <- getArgs + let os = if (length args) > 0 then roffsets else offsets + let tuples = zip ordinals $ selectGifts os putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples From 84d2c22974752be5a6c4bdb0fed426afd288a6a7 Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Wed, 24 Dec 2025 14:21:40 +1100 Subject: [PATCH 5/6] Fixed a bug with the ordinal words --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 20acac2..fa4c98f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -139,5 +139,5 @@ main = do let roffsets = randomOffsets gen allGifts args <- getArgs let os = if (length args) > 0 then roffsets else offsets - let tuples = zip ordinals $ selectGifts os + let tuples = zip (reverse ordinals) $ selectGifts os putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples From 9fa103dca7d4ddc6e917325d920f0ea3e813a510 Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Wed, 24 Dec 2025 14:23:05 +1100 Subject: [PATCH 6/6] Updated readme with samples of the random version --- README.md | 53 +++++++++++++++++++++++++- original.txt | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++ random1.txt | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++ random2.txt | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++ random3.txt | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 464 insertions(+), 1 deletion(-) create mode 100644 original.txt create mode 100644 random1.txt create mode 100644 random2.txt create mode 100644 random3.txt diff --git a/README.md b/README.md index 4d16178..47a4e45 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,58 @@ Days of Christmas. This is the most stupidly Haskell way I could think of: it makes a product of all the combinations of "$NUMBER $WORD $WORD" and then filters them. Filtering on word length alone wasn't enough, so the signature for each gift also includes -the offset into the following lists: +the offset into the lists of alternatives at the end of this page. + +ADDENDUM: I added a flag which makes the script pick randomly from the list of +alternatives, which gives Oulipian variants on the original which have the quality +that the lines (and the spacing of the words) are the same length, for example: + +``` +On the twelfth day of Christmas my true love gave to me +Eleven drummers drumming +Eleven French piping +Ten lords a-leaping +Nine French dancing +Seven geese a-leaping +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the twelfth day of Christmas my true love gave to me +Eleven drummers drumming +Eleven turtle piping +Ten geese a-milking +Nine French dancing +Eight maids a-leaping +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the twelfth day of Christmas my true love gave to me +Eleven drummers drumming +Eleven turtle piping +Six maids a-milking +Five ladies dancing +Three lords a-milking +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree +``` + +[Original](original.txt) | [Random 1](random1.txt) | [Random 2](random2.txt) | [Random 3](random3.txt) + ``` two turtle doves diff --git a/original.txt b/original.txt new file mode 100644 index 0000000..8592bee --- /dev/null +++ b/original.txt @@ -0,0 +1,103 @@ +On the first day of Christmas my true love gave to me +A partridge in a pear tree + +On the second day of Christmas my true love gave to me +Two turtle doves +And a partridge in a pear tree + +On the third day of Christmas my true love gave to me +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the fourth day of Christmas my true love gave to me +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the fifth day of Christmas my true love gave to me +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the sixth day of Christmas my true love gave to me +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the seventh day of Christmas my true love gave to me +Seven swans a-swimming +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the eighth day of Christmas my true love gave to me +Eight maids a-milking +Seven swans a-swimming +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the ninth day of Christmas my true love gave to me +Nine ladies dancing +Eight maids a-milking +Seven swans a-swimming +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the tenth day of Christmas my true love gave to me +Ten lords a-leaping +Nine ladies dancing +Eight maids a-milking +Seven swans a-swimming +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the eleventh day of Christmas my true love gave to me +Eleven pipers piping +Ten lords a-leaping +Nine ladies dancing +Eight maids a-milking +Seven swans a-swimming +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + +On the twelfth day of Christmas my true love gave to me +Twelve drummers drumming +Eleven pipers piping +Ten lords a-leaping +Nine ladies dancing +Eight maids a-milking +Seven swans a-swimming +Six geese a-laying +Five gold rings +Four calling birds +Three French hens +Two turtle doves +And a partridge in a pear tree + + diff --git a/random1.txt b/random1.txt new file mode 100644 index 0000000..7d73565 --- /dev/null +++ b/random1.txt @@ -0,0 +1,103 @@ +On the first day of Christmas my true love gave to me +A partridge in a pear tree + +On the second day of Christmas my true love gave to me +Six French birds +And a partridge in a pear tree + +On the third day of Christmas my true love gave to me +Eight French hens +Six French birds +And a partridge in a pear tree + +On the fourth day of Christmas my true love gave to me +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the fifth day of Christmas my true love gave to me +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the sixth day of Christmas my true love gave to me +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the seventh day of Christmas my true love gave to me +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the eighth day of Christmas my true love gave to me +Seven geese a-leaping +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the ninth day of Christmas my true love gave to me +Nine French dancing +Seven geese a-leaping +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the tenth day of Christmas my true love gave to me +Ten lords a-leaping +Nine French dancing +Seven geese a-leaping +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the eleventh day of Christmas my true love gave to me +Eleven French piping +Ten lords a-leaping +Nine French dancing +Seven geese a-leaping +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + +On the twelfth day of Christmas my true love gave to me +Eleven drummers drumming +Eleven French piping +Ten lords a-leaping +Nine French dancing +Seven geese a-leaping +Eight geese a-swimming +Ten swans a-laying +Nine gold doves +Four calling rings +Eight French hens +Six French birds +And a partridge in a pear tree + + diff --git a/random2.txt b/random2.txt new file mode 100644 index 0000000..018a2ce --- /dev/null +++ b/random2.txt @@ -0,0 +1,103 @@ +On the first day of Christmas my true love gave to me +A partridge in a pear tree + +On the second day of Christmas my true love gave to me +Six French doves +And a partridge in a pear tree + +On the third day of Christmas my true love gave to me +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the fourth day of Christmas my true love gave to me +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the fifth day of Christmas my true love gave to me +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the sixth day of Christmas my true love gave to me +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the seventh day of Christmas my true love gave to me +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the eighth day of Christmas my true love gave to me +Eight maids a-leaping +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the ninth day of Christmas my true love gave to me +Nine French dancing +Eight maids a-leaping +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the tenth day of Christmas my true love gave to me +Ten geese a-milking +Nine French dancing +Eight maids a-leaping +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the eleventh day of Christmas my true love gave to me +Eleven turtle piping +Ten geese a-milking +Nine French dancing +Eight maids a-leaping +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + +On the twelfth day of Christmas my true love gave to me +Eleven drummers drumming +Eleven turtle piping +Ten geese a-milking +Nine French dancing +Eight maids a-leaping +Eight swans a-swimming +Ten lords drumming +Five gold rings +Nine calling rings +Three ladies hens +Six French doves +And a partridge in a pear tree + + diff --git a/random3.txt b/random3.txt new file mode 100644 index 0000000..245d37b --- /dev/null +++ b/random3.txt @@ -0,0 +1,103 @@ +On the first day of Christmas my true love gave to me +A partridge in a pear tree + +On the second day of Christmas my true love gave to me +Ten French rings +And a partridge in a pear tree + +On the third day of Christmas my true love gave to me +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the fourth day of Christmas my true love gave to me +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the fifth day of Christmas my true love gave to me +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the sixth day of Christmas my true love gave to me +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the seventh day of Christmas my true love gave to me +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the eighth day of Christmas my true love gave to me +Three lords a-milking +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the ninth day of Christmas my true love gave to me +Five ladies dancing +Three lords a-milking +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the tenth day of Christmas my true love gave to me +Six maids a-milking +Five ladies dancing +Three lords a-milking +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the eleventh day of Christmas my true love gave to me +Eleven turtle piping +Six maids a-milking +Five ladies dancing +Three lords a-milking +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +On the twelfth day of Christmas my true love gave to me +Eleven drummers drumming +Eleven turtle piping +Six maids a-milking +Five ladies dancing +Three lords a-milking +Seven maids a-swimming +Six maids drumming +Nine gold birds +Four calling rings +Seven ladies hens +Ten French rings +And a partridge in a pear tree + +