Pi Wordplay

Author

Eric W. Weisstein
November 1, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Constants/PiWordplay.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PiWordplay.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Code

NonZero[n_]:=If[n==0,False,True]

SetAttributes[NonZero,Listable];

Mnemonic::bad = "Mnemonic disagrees with constant `1` at digit `2` and word \"`3`\"";

Mnemonic[n_,s0_String]:=Module[
	{
s=StringReplace[s0,{"'"->""}],
str,l,dif,baddig,p,words
},
str=StringToStream[s];
	l=Map[StringLength,words=ReadList[str,Word,WordSeparators->{" ",",",".","?",":","!","$","-"}] /. {"O"->"","`"->""}];
	l=l /.{10->0,11->{1,1},12->{1,2},13->{1,3},14->{1,4},15->{1,5}}//Flatten;
	(* Kludge, but treat `!' by chucking ! and ' and changing ` to "" *)

(* work around RealDigits bug/limitation by computing one more digit *)
	dif=l-Most[RealDigits[n,10,Length[l]+1][[1]]];
	baddig=Select[dif,NonZero,1];
	If[baddig=={},Length[l],
	Message[Mnemonic::bad,n,p=Position[dif,baddig[[1]]][[1,1]],words[[p]]]
	]
]

ToNumber[n_,d_]:=Module[{r=RealDigits[n,10,d]},
StringInsert[StringJoin[ToString/@r[[1]]],".",1+r[[-1]]]
]

Pi

Chris Heckman, Feb. 3, 2005

Mnemonic[Pi,"How I wish I could calculate pi"]

Gardner

Mnemonic[Pi,"May I have a large container of coffee?"]

Mnemonic[Pi,"But I must a while endeavour to reckon right."]

Amling, Jul 30, 2004

Mnemonic[Pi,"May I have a white telephone, or
pastel color, and please expedite."]

Mnemonic[Pi,"May I have a white telephone, or
pastel color."]

Mnemonic[Pi,"How I need a drink, alcoholic of course,
	after the heavy lectures involving quantum
	mechanics."]

Mnemonic[Pi,"How I need a drink, alcoholic of course,
	after the heavy lectures involving quantum
	mechanics. All of thy geometry, Herr Planck, is fairly hard."]

Mnemonic[Pi,"Now I will a rhyme construct, By chosen words the young instruct. Cunningly
devised endeavour, Con it and remember ever. Widths in circle here you see
Sketched out in strange obscurity."]

Mnemonic[Pi,"How I need a drink, alcoholic of course,
	after the heavy lectures involving quantum
	mechanics, and if the lectures were boring or tiring, then any odd thinking was on quartic equations again."]

ToNumber[Pi,32]

Mnemonic[Pi,"Pie, E.: Near a Raven.  
		Midnights so dreary, tired and weary.
		Silently pondering volumes extolling all by-now obsolete lore.
		During my rather long nap-the weirdest tap!
		An ominous vibrating sound disturbing my chamber's antedoor.
		'This,' I whispered quietly, 'I ignore.'
		
		Perfectly, the intellect remembers: the ghostly fires, a glittering ember.
		Inflamed by lightning's outbursts, windows cast penumbras upon this floor.
		
		Sorrowful, as one mistreated, unhappy thoughts I heeded:
		That inimitable lesson in elegance-Lenore-
		is delighting, exciting...nevermore."]

Mnemonic[Pi,"Moi, j' aime a faire connaitre un nombre utile aux sages"]

Mnemonic[Pi,"Moi, j' aime a faire connaitre un nombre utile aux sages, immortel Archimède,artiste, ingénieur"]

Base-26

pi26=First[RealDigits[Pi,26,100]]/.Thread[Range[0,25]->CharacterRange["a","z"]]

pi26=Rest[First[RealDigits[Pi,26,10^6]]/.Thread[Range[0,25]->CharacterRange["a","z"]]];

<<Miscellaneous`Dictionary`

GetDictionary[]

Length[$Dictionary]

$LowerCaseDictionary=Join[
DeleteCases[
DeleteCases[Select[$Dictionary,StringMatchQ[#,RegularExpression["^[a-z]+$"]]&],("rs"|"dd"|"dded"|"dding"|"dds")&],_?(StringMatchQ[#,RegularExpression["^.s$"]]&)],{"as","is","o","us","subplot"}];

Length[$LowerCaseDictionary]

NLetterWord[n_,str_List:pi26,i0_:1]:=Module[{i=i0,len=Length[str]-n},
While[!MemberQ[$LowerCaseDictionary,StringJoin@@Take[str,{i,i+n-1}]]&&i<len,i++];
If[i==len,{0,""},
{i,StringJoin@@Take[pi26,{i,i+n-1}]}
]
]

AllNLetterWords[n_,str_:pi26,i0_:1]:=Module[{i=i0,l={},len=Length[str]},
While[i<len,
If[MemberQ[$LowerCaseDictionary,s=StringJoin@@Take[str,{i,i+n-1}]],Print[{i,s}];AppendTo[l,{i,s}]
];
i++];
l
]

NLetterWord/@Range[4]//Timing

NLetterWord/@Range[5]//Timing

NLetterWord/@Range[6]//Timing

NLetterWord/@Range[7]//Timing

Take[pi26,{0,6}+115042]

AllNLetterWords[5]

AllNLetterWords[6]

AllNLetterWords[6,pi26,48400]