bombinans/xmasTwelve
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feature-random #1

Merged
bombinans merged 6 commits from feature-random into main 2025-12-24 03:23:53 +00:00
Conversation 0 Commits 6 Files Changed 8 +510 -23
8 changed files with 510 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
README.md
View File

@ -6,7 +6,58 @@ Days of Christmas.
This is the most stupidly Haskell way I could think of: it makes a product of 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 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 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 two turtle doves

64
app/Main.hs
View File

@ -1,5 +1,8 @@
module Main (main) where module Main (main) where
import System.Random
import System.Environment
ordinals :: [ String ] ordinals :: [ String ]
ordinals = [ ordinals = [
"second", "second",
@ -15,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 = reverse [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ]
cardinals :: [ String ] cardinals :: [ String ]
cardinals = [ cardinals = [
"Two", "Two",
@ -87,10 +93,15 @@ 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 wrapGifts :: ( Int, Int, Int ) -> [ String ]
wrapGift (i, j, k, l) = gs !! l wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k)
where
gs = 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 :: [ 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,21 @@ 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 ] ] -> [ 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 :: 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

103
original.txt Normal file
View File

@ -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

1
package.yaml
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

103
random1.txt Normal file
View File

@ -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

103
random2.txt Normal file
View File

@ -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

103
random3.txt Normal file
View File

@ -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

3
xmasTwelve.cabal
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