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/app/Main.hs b/app/Main.hs index d6eab66..fa4c98f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,8 @@ module Main (main) where +import System.Random +import System.Environment + ordinals :: [ String ] ordinals = [ "second", @@ -15,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 = reverse [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ] + cardinals :: [ String ] cardinals = [ "Two", @@ -87,10 +93,15 @@ 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) +wrapGifts :: ( Int, Int, Int ) -> [ String ] +wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k) + +allGifts :: [ [ String ] ] +allGifts = map wrapGifts $ reverse signatures + +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 @@ -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,21 @@ 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 ] ] -> [ 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 = putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples +main = do + gen <- newStdGen + let roffsets = randomOffsets gen allGifts + args <- getArgs + let os = if (length args) > 0 then roffsets else offsets + let tuples = zip (reverse ordinals) $ selectGifts os + putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples 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/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 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 + + 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