Message Boards Message Boards

GROUPS:
Authoring and Publishing Data Science Mathematics Robotics Social Science Software Development Mathematica Statistics and Probability
David Reiss

Pi Day Challenge: write a novel like a monkey

David Reiss, Scientific Arts
Posted 6 years ago
9873 Views
|
5 Replies
|
21 Total Likes
|

Can a monkey type Shakespeare's works by only using words randomly appearing from the digits of Pi? I think it's a challenge...

But perhaps we can use Pi to define a restricted subset of the English Language....

Here is a function (MonkeyPiWords[nLetters, wordLength]) that takes Pi and generates the random english words that can be conjured up from Pi's digits. nLetters are generated from Pi in the sequence they are derived from the digits fo Pi, and then all english words of wordLength letters long from that sequence (in order, partitioned in sets wordLength letters long) are returned (taking into account tht the algorithm has an ambiguity of 3 positions for where to start).

So the challenge is to take the vocabulary returned by this for a fixed number of input letters and write a significant story with only those words...

Here is a function to define the problem: (Note: see bug fixed version later in this thread)

MonkeyPiWords[nLetters_Integer, wordLength_Integer] :=

 Module[{characteCodes, characteCodesRules, piDigitsAsCharacterCodes1,
    piDigitsAsCharacterCodes2, piDigitsAsCharacterCodes3, 
   monkeyCharacters1, monkeyWords1, monkeyCharacters2, monkeyWords2, 
   monkeyCharacters3, monkeyWords3, monkeyWords},

  characteCodes = ToCharacterCode["abcdefghijklmnopqrstuvwxyz"];
  characteCodesRules = 
   Thread[Range[Length[characteCodes]] -> characteCodes];

  piDigitsAsCharacterCodes1 = 
   Mod[#, 26] & /@ 
     FromDigits /@ 
      Partition[First[RealDigits[N[\[Pi], 3 nLetters]]], 3] /. 
    characteCodesRules;
  piDigitsAsCharacterCodes2 = 
   Mod[#, 26] & /@ 
     FromDigits /@ 
      Partition[Rest@First[RealDigits[N[\[Pi], 3 nLetters]]], 3] /. 
    characteCodesRules;
  piDigitsAsCharacterCodes3 = 
   Mod[#, 26] & /@ 
     FromDigits /@ 
      Partition[Rest@Rest@First[RealDigits[N[\[Pi], 3 nLetters]]], 
       3] /. characteCodesRules;

  monkeyCharacters1 = FromCharacterCode /@ piDigitsAsCharacterCodes1;
  monkeyWords1 = 
   StringJoin /@ Partition[monkeyCharacters1, wordLength];

  monkeyCharacters2 = FromCharacterCode /@ piDigitsAsCharacterCodes2;
  monkeyWords2 = 
   StringJoin /@ Partition[monkeyCharacters2, wordLength];

  monkeyCharacters3 = FromCharacterCode /@ piDigitsAsCharacterCodes3;
  monkeyWords3 = 
   StringJoin /@ Partition[monkeyCharacters3, wordLength];

  Union@Flatten[{DictionaryLookup[#, IgnoreCase -> True] & /@ 
      monkeyWords1, 
     DictionaryLookup[#, IgnoreCase -> True] & /@ monkeyWords2, 
     DictionaryLookup[#, IgnoreCase -> True] & /@ monkeyWords3}]
  ]

Here are the results for words of 4 letters or greater using 100000 letters in sequence derived from Pi using the above algorithm: (Assume you can use any 1, 2 or 3 letter words, but you can restrict yourself by doing those computations as well):

4-Letter words

MonkeyPiWords[100000, 4]

gives

  {"Abel", "able", "ably", "achy", "acid", "acne", "Adam", "Afro", \
  "agar", "AIDS", "Ajax", "Alar", "Alex", "Alpo", "also", "alum", \
  "Alva", "ammo", "arcs", "arid", "Arne", "ates", "Audi", "Avon", \
  "ayes", "Bach", "back", "bags", "bait", "bank", "bans", "bare", \
  "bark", "bash", "Bass", "bath", "bats", "beam", "Beck", "Bede", \
  "belt", "berm", "bibs", "bids", "Biko", "Biro", "bits", "bock", \
  "Boer", "Bond", "bone", "boor", "Boru", "boss", "bowl", "brat", \
  "Bret", "Buck", "buds", "buff", "bump", "burg", "burk", "burp", \
  "Burt", "bury", "Bush", "buss", "byes", "cafe", "camp", "Caph", \
  "cask", "cast", "Cebu", "ceca", "cell", "chat", "chew", "chip", \
  "chug", "clad", "Clay", "clod", "Cobb", "coed", "Colo", "cony", \
  "cope", "cord", "Cork", "Cote", "craw", "Cray", "Cree", "cubs", \
  "dads", "damn", "damp", "dams", "Dana", "Dare", "darn", "Dave", \
  "days", "Debs", "dews", "dewy", "dibs", "dice", "Dick", "dike", \
  "Dina", "dine", "dint", "dire", "docs", "doll", "dome", "dots", \
  "Doug", "dour", "dram", "duck", "duel", "dues", "duff", "duns", \
  "duos", "duty", "Dyer", "dyes", "earn", "eats", "eave", "eBay", \
  "echo", "eels", "Elam", "Elia", "elks", "emus", "Enid", "Enif", \
  "ergo", "ergs", "errs", "etas", "even", "expo", "fame", "faro", \
  "fast", "fate", "fats", "fave", "file", "fink", "fish", "flap", \
  "flay", "flue", "flux", "Fons", "form", "foul", "fret", "Frye", \
  "gabs", "garb", "gash", "geed", "gels", "Gish", "give", "glad", \
  "glam", "glee", "glut", "gnat", "goad", "gone", "Goth", "gout", \
  "govs", "grab", "gram", "grip", "gust", "guys", "Haas", "hags", \
  "hake", "half", "Hans", "hard", "harp", "hasp", "hast", "heat", \
  "Herr", "hick", "high", "hilt", "hims", "hips", "hire", "Hiss", \
  "honk", "hove", "howl", "hows", "HTTP", "huge", "Hugh", "hugs", \
  "hump", "hums", "Hung", "hurl", "Hyde", "hymn", "Iago", "icky", \
  "iffy", "Igor", "ills", "imps", "inky", "Iraq", "ires", "isms", \
  "Iyar", "Jack", "jags", "jamb", "Jame", "jaws", "jerk", "Jock", \
  "Jose", "Karl", "kart", "kegs", "Kent", "Kern", "Kerr", "Kiel", \
  "kind", "Klee", "knob", "know", "kook", "Kory", "Kroc", "lacs", \
  "lade", "Lady", "lair", "lame", "Lang", "lank", "Laud", "Leda", \
  "Left", "lest", "lido", "lids", "lief", "Lima", "limo", "Lind", \
  "lips", "Lisa", "lisp", "live", "loaf", "loam", "loch", "lock", \
  "logo", "Lois", "Lola", "loll", "lone", "loot", "Lora", "lose", \
  "Luce", "luff", "lugs", "Lvov", "Lyon", "Mack", "maim", "malt", \
  "Mani", "Mann", "many", "Mark", "mask", "mast", "math", "Matt", \
  "mean", "meat", "meed", "menu", "mine", "mini", "moat", "Moll", \
  "mosh", "moth", "mows", "Mses", "muns", "nabs", "nags", "naif", \
  "nail", "Nell", "neon", "Nile", "Nola", "none", "nuke", "oaks", \
  "Obie", "odor", "oiks", "oils", "Olga", "open", "opts", "oral", \
  "Oran", "orgy", "Otis", "ouch", "oven", "Ovid", "pacy", "pals", \
  "pave", "pear", "peas", "peek", "pews", "Pike", "pink", "pips", \
  "Pisa", "pith", "Pius", "plan", "ploy", "plug", "poem", "pool", \
  "pore", "poxy", "prig", "prod", "punt", "purl", "purr", "quid", \
  "race", "rack", "raid", "rail", "rang", "rare", "rash", "rats", \
  "redo", "regs", "Reno", "revs", "rhos", "rift", "Riga", "rile", \
  "rims", "riot", "robe", "roil", "role", "Rolf", "roof", "rook", \
  "Rory", "Roth", "rove", "rows", "RSVP", "Ruby", "ruck", "saga", \
  "sago", "sags", "Saks", "Sang", "sank", "saps", "sash", "Sask", \
  "says", "Sean", "sear", "seed", "Sega", "Serb", "shad", "shim", \
  "shiv", "shop", "shot", "skid", "slaw", "slay", "slum", "Snow", \
  "sock", "spot", "spur", "star", "stun", "suck", "sued", "suit", \
  "suns", "sure", "Suva", "swab", "swan", "tabs", "talc", "tall", \
  "taps", "teal", "tear", "teen", "than", "tics", "tier", "Tina", \
  "toed", "toes", "toms", "tong", "toot", "tore", "tori", "toss", \
  "tots", "Tran", "trug", "twas", "twit", "undo", "unto", "urns", \
  "Utes", "vars", "vats", "veil", "vise", "Vlad", "wait", "wane", \
  "wart", "ween", "weir", "when", "whey", "whit", "whys", "Will", \
  "wilt", "wink", "Wise", "Witt", "wive", "wold", "worm", "yeas", \
  "yips", "Yoko", "Yugo", "Yuma"}

5-Letter Words

MonkeyPiWords[100000, 5]

gives

{"build", "carom", "chaps", "coons", "Corby", "crank", "Derry", \
"Dolby", "dotes", "drier", "found", "Golgi", "honks", "jacks", \
"Josef", "Kenny", "Magoo", "Major", "Mavis", "parka", "pates", \
"plebe", "queue", "Reese", "ruing", "scarp", "smirk", "smugs", \
"souse", "sward", "teens", "Tulsa", "vivid", "Willa", "writs"}

6-Letter words

MonkeyPiWords[100000, 6]

gives

   {"alkyds", "churns", "paring", "toupee"}

Beyond that there are no (up to 10 letter words) further words.
POSTED BY: David Reiss
Answer
5 Replies
Sort By:
Caitlin Ramsey
Caitlin Ramsey
Posted 6 years ago

Well I suppose it would depend on what one considers "interesting." As you say, these monkeys don't seem to possess a strong suit for determining part-of-speech (not to mention verb conjugation)! 

sillyWords = ToString@Catenate@{RandomChoice[interjections, 1], {"!"}, RandomChoice[prepositions, 1], RandomChoice[pronouns, 1], RandomChoice[verbs, 1], RandomChoice[determiners, 1], RandomChoice[nouns, 1], RandomChoice[prepositions, 1], RandomChoice[determiners, 1]}

"{oho, !, in, him, pips, an, loo, own, unto}"

"Oho ! In him pips an loo, unto own."

Happy Pi Day!

Attachments:
monkey_pi_wr.nb
POSTED BY: Caitlin Ramsey
Answer

It's a challenging life being a simian author, but yours seems well on its way to being a deified oracle.
POSTED BY: David Reiss
Answer

Sorry David, I had trouble understanding your code. Is it in base 26? I seem to be getting a different list, seems like even with the first 1000 characters you get a viable list of words.

characters3 = FromCharacterCode[ RealDigits[Pi, 26, 1000][[1]] + ToCharacterCode["a"][[1]]];

words3 = Select[DictionaryLookup[], StringCount[characters3, #] > 0 &]

{"a", "ad", "ah", "am", "an", "ape", "as", "ax", "ban", "bank", "be", "bi", \
"biz", "by", "cox", "cs", "cw", "db", "dc", "dim", "do", "dos", "egg", "eh", \
"elm", "em", "en", "er", "ex", "fa", "fan", "fez", "go", "gs", "he", "hi", \
"hm", "ho", "hub", "huh", "id", "if", "ifs", "ilk", "is", "ism", "isms", \
"it", "jg", "ks", "kw", "la", "lap", "lee", "lo", "lop", "ls", "ma", "me", \
"meg", "mi", "ms", "mu", "my", "new", "no", "not", "nu", "of", "oh", "oi", \
"oik", "om", "on", "or", "ow", "ox", "pa", "pad", "pea", "pew", "pi", "ply", \
"pow", "re", "rock", "rod", "rs", "so", "sow", "sud", "ta", "tax", "ti", \
"to", "trod", "ts", "tux", "uh", "um", "up", "vs", "we", "wed", "xi", "ya", \
"yo", "zap", "zed"}

I am an ape as I ax a rock by my new pad.
POSTED BY: Todd Rowland
Answer

What the code does (not completely obvious by looking at it, I know) is this. It takes the digits of Pi and partitions them into groups of 3. Then it takes each of these groups and turns them into the corresponding integer. Each of these integers is then Mod'd by 26, (number of letters in the english alphabet) thereby getting values between 0 and 25. This is then used to map to the character codes of the 26 letters using the characteCodesRules. Then groups of letters wordLength long are put together and checked to see if they are a word.

But, I see now that my original code has a small bug...

It had

  characteCodesRules = 
   Thread[Range[Length[characteCodes]] -> characteCodes];

but this should have been

characteCodesRules = 
  Thread[Range[{0, Length[characteCodes] - 1}] -> characteCodes];

So, here is the updated code (so I don't have to edit the whole original post ;-) )

MonkeyPiWords[nLetters_Integer, wordLength_Integer] :=

 Module[{characteCodes, characteCodesRules, piDigitsAsCharacterCodes1,
    piDigitsAsCharacterCodes2, piDigitsAsCharacterCodes3, 
   monkeyCharacters1, monkeyWords1, monkeyCharacters2, monkeyWords2, 
   monkeyCharacters3, monkeyWords3, monkeyWords},

  characteCodes = ToCharacterCode["abcdefghijklmnopqrstuvwxyz"];
  characteCodesRules = 
   Thread[Range[0, Length[characteCodes] - 1] -> characteCodes];

  piDigitsAsCharacterCodes1 = 
   Mod[#, 26] & /@ 
     FromDigits /@ 
      Partition[First[RealDigits[N[\[Pi], 3 nLetters]]], 3] /. 
    characteCodesRules;
  piDigitsAsCharacterCodes2 = 
   Mod[#, 26] & /@ 
     FromDigits /@ 
      Partition[Rest@First[RealDigits[N[\[Pi], 3 nLetters]]], 3] /. 
    characteCodesRules;
  piDigitsAsCharacterCodes3 = 
   Mod[#, 26] & /@ 
     FromDigits /@ 
      Partition[Rest@Rest@First[RealDigits[N[\[Pi], 3 nLetters]]], 
       3] /. characteCodesRules;

  monkeyCharacters1 = FromCharacterCode /@ piDigitsAsCharacterCodes1;
  monkeyWords1 = 
   StringJoin /@ Partition[monkeyCharacters1, wordLength];

  monkeyCharacters2 = FromCharacterCode /@ piDigitsAsCharacterCodes2;
  monkeyWords2 = 
   StringJoin /@ Partition[monkeyCharacters2, wordLength];

  monkeyCharacters3 = FromCharacterCode /@ piDigitsAsCharacterCodes3;
  monkeyWords3 = 
   StringJoin /@ Partition[monkeyCharacters3, wordLength];

  Union@Flatten[{DictionaryLookup[#, IgnoreCase -> True] & /@ 
      monkeyWords1, 
     DictionaryLookup[#, IgnoreCase -> True] & /@ monkeyWords2, 
     DictionaryLookup[#, IgnoreCase -> True] & /@ monkeyWords3}]
  ]

For 1000 characters this gives (for comparison with your approach's result):

Flatten[{MonkeyPiWords[1000, 1], MonkeyPiWords[1000, 2], 
  MonkeyPiWords[1000, 3]}]

yielding

{"a", "I", "AD", "ah", "AM", "an", "as", "at", "ax", "BC", "be", \
"bi", "by", "CD", "cs", "cw", "dB", "dc", "DJ", "do", "eh", "em", \
"en", "er", "es", "ET", "ex", "fa", "FM", "GI", "go", "GP", "gs", \
"ha", "hi", "hm", "ho", "HQ", "ID", "in", "IQ", "IT", "jg", "Jo", \
"kc", "KO", "ks", "kW", "la", "Le", "lo", "ls", "ma", "MC", "me", \
"mi", "Mr", "Ms", "mu", "my", "no", "nu", "of", "oh", "OK", "om", \
"on", "or", "ow", "ox", "Oz", "pa", "PC", "pH", "pi", "PM", "re", \
"Rh", "rs", "Rx", "sh", "so", "ta", "ti", "TM", "to", "ts", "TV", \
"Ty", "uh", "UK", "UN", "up", "vs", "Wm", "Wu", "xi", "XL", "ya", \
"ye", "yo", "Ada", "aka", "amp", "bed", "bog", "Coy", "cud", "elk", \
"Ely", "fag", "FAQ", "foe", "Fox", "gee", "git", "GOP", "ins", "IOU", \
"ire", "jam", "Lee", "Lev", "LSD", "Max", "MBA", "MCI", "Moe", "moo", \
"nil", "now", "ode", "ope", "ops", "Orr", "Pei", "pug", "raw", "rev", \
"sad", "sap", "spy", "sty", "tap", "tar", "Tia", "tux", "TVs", "TWA", \
"URL", "way", "woe"}

the same order of magnitude number of words as yours.
POSTED BY: David Reiss
Answer

Attaching my notebook...

Attachments:
PiDay.nb
POSTED BY: David Reiss
Answer
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract