5
$\begingroup$

I saw something interesting about text-analysis - bigrams - in Basic Text Analysis in Mathematica

I wondered how the bigrams of Pi's digits might appear. As expected, take enough terms and every integer in the range 0-9 has been followed by every other number (including itself).

Here's my code -- I'm sure it can be improved, but that's my second question:

t = Table[ edgeList = Map[#[[1]] -> #[[2]] &, Partition[First[RealDigits[N[π, J]]], 2, 1]]; g = Graph[Union[edgeList], VertexLabels -> "Name"]; am = AdjacencyMatrix[g]; Total[am, 2], {J, 2, 600} ]; ListLinePlot[t] t

The idea here is that the total of the adjacency matrix of the bigram graph tells you when you've looked at enough of Pi's digits for every single-digit integer to have been followed by every single digit integer.

The problem I have found in the result (looking at ListLinePlot[t], and then inspecting the sequence of Total[AdjMat, 2]) is that the plot isn't monotonic. I have to think that there's something I've done/omitted in the code, but no matter how hard I look I can't see it.

Can anyone see the problem that causes incorrectness of results?

Improve this question
$\endgroup$

1 Answer 1

Reset to default
8
$\begingroup$

Change one line of your code :

Partition[IntegerDigits@IntegerPart@(Pi*10^(J - 1)), 2, 1]

You could also use:

First[RealDigits[N[Pi, J+1], 10, J]]

As an aside, here's how I'd do it...

trend = With[{pidi = Partition[First@RealDigits[N[Pi, 1000]], 2, 1], dummy = Transpose@{Range[0, 9]}}, Table[Length /@ DeleteDuplicates /@ GatherBy[Join[dummy, pidi[[;; j - 1]]], First], {j, 2, 600}] - 1]; Column[{ListLinePlot[Total /@ trend, ImageSize -> 400], ListLinePlot[Count[#, 10] & /@ trend, ImageSize -> 400], ListLinePlot[Transpose@trend, PlotLegends -> Range[0, 9], PlotStyle -> "Rainbow", ImageSize -> 400]}]

enter image description here

Giving your results, the count of how many digits have reached their fill, and the trends for the individual digits... n.b.: The plots are from 10-650, I later changed the code to match your index start/end.

If you're looking to extend this to bigger searches, you'll probably want to use something more efficent (the above is more efficient than yours, but for huge searches it's not optimal). Mathematica has very efficient string mechanisms, and often search problems of this sort can be done much more efficiently using them.

Here's an example, extending the search to trigrams. Completes in milliseconds on a ratty old netbook:

s = IntegerString[IntegerPart[Pi*10^10000]]; sp = Sort /@ Partition[StringPosition[s, StringTake["00" <> ToString@#, -3], 1] & /@ Range[0, 999], 100][[All, All, 1, -1]]; ListPlot[Table[Tr[UnitStep[z - Flatten@sp]], {z, 3, 10000}], ImageSize -> 400]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ thanks - I see your code is more elegant than mine though I can't see why one would Join static 'dummy' to digits of Pi. I also cannot understand the error in my original code (I see you advised "replace the first line", but that doesn't explain what my error is. $\endgroup$ Commented Feb 28, 2015 at 4:31
  • 1
    $\begingroup$ @Paul_A: Sorry, figured it would be evident from the change. Do RealDigits[N[Pi, 5]], then RealDigits[N[Pi, 6]]. Look at the fifth digit in both. Rounding was your nemesis. As far as your code and "elegant", I disagree with your comment: I find your approach quite elegant, the use of Adj. Mat. sums clever. It's just not particularly efficient or quite as extension-friendly. As for the dummy join: gather/tally/et. al "index" in the order of "new" items seen. So this allows me to force 0,1,2... order. Otherwise, you'd have to figure out data order post hoc. Cleaner, IMO. $\endgroup$ Commented Feb 28, 2015 at 5:33
  • $\begingroup$ Dang! I should have seen that - something was nagging at me and at your mention of 'rounding' it hit home. Thanks also for the explanation of your rationale. $\endgroup$ Commented Feb 28, 2015 at 5:39

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.