6
$\begingroup$

This code

Needs["Calendar`"]; days = {Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday}; c = Count[ Flatten[Table[ DayOfWeek[{y, m, 13}], {y, 2000, 2399}, {m, 12}]], #] & /@ days; TableForm[ { days, c, PaddedForm[#, {6, 4}] & /@ (100. c/Plus @@ c), ToString //@ Flatten[Position[Sort[c, Greater], #]] & /@ c}, TableDirections -> {Row, Column}, TableHeadings -> {{"day", "numbers of 13s", "percentage", "rank"}, None}]

will give this table: (counts of 13ths over days of week, using 400 years data)

enter image description here

(this is used as an illustration of interesting fact that 13th is more likely to be Friday than any other day of week)

How can I obtain a table that counts Fridays over days of month (1st, 2nd, ...) also over 400 years?

Improve this question
$\endgroup$
5
  • $\begingroup$ Do I understand the data needs correctly - you want over the 400 year period, a tally of Fridays by the day of month they fell on (regardless of month), that you'll then tabulate? $\endgroup$ Commented Jul 6, 2014 at 7:51
  • $\begingroup$ Correct. @rasher $\endgroup$ Commented Jul 6, 2014 at 7:52
  • $\begingroup$ Isn't the first position of Friday an artefact of your choice of start and end year? If you choose {y, 1993, 2402} Wednesday will be first. $\endgroup$ Commented Jul 7, 2014 at 11:08
  • 1
    $\begingroup$ Paraskevidekatriaphobia... ubpdqn.wordpress.com/2012/04/13/paraskevidekatriaphobia (just for amusement) $\endgroup$ Commented Jul 7, 2014 at 12:52
  • $\begingroup$ @SjoerdC.deVries 400 years is chosen on purpose - that's period of Gregorian calendar, and number of days is fortunately divisible by 7, so any full 400 years weekday/monthday pattern is repeated forever. You chose 410 years, but this result doesn't mean anything, no conclusion regarding probability can be deduced. :) $\endgroup$ Commented Jul 7, 2014 at 19:43

3 Answers 3

Reset to default
4
$\begingroup$

Some further observations:

data = Cases[DayRange[{401, 1, 1}, {2400, 12, 31}, Friday], {y_, _, 13} -> y]; x = Length /@ Split[data]; {Min@x, Max@x, N[Mean@x, 10]}

{1, 3, 1.720000000}

There are EXACTLY 1.72 Fridays 13th per year over a 400 year period. This can be calculated as follows:

The Gregorian calendar follows a pattern of leap years which repeats every 400 years. There are 4800 months in 400 years, therefore with 688 from the above tables:

N[12*688/4800, 10]

1.720000000

Count[x, #] & /@ {1, 2, 3}

{855, 850, 295}

Pattern of the 295 years with three Fridays 13th:

three = Length /@ Rest@Most@Cases[Split[x /. (1 | 2) -> 0], {___, 0, ___}]; ListPlot[three, AxesOrigin -> {0, 0}, Filling -> Bottom, Ticks -> {Range[0, 295, 59], {2, 5, 10, 11}}, ImageSize -> 600]

enter image description here

This pattern is regular with a repetition of 59 (which is the 17th prime number) years:

Differences@Flatten@Position[three, 11]

{59, 59, 59, 59}

The next scary years are:

 Cases[Split@Cases[DayRange[{2014, 1, 1}, {2099, 12, 31}, Friday], {y_, _, 13} :>y], {y_, _, _} :> y]

{2015, 2026, 2037, 2040, 2043, 2054, 2065, 2068, 2071, 2082, 2093, 2096, 2099}

Improve this answer
$\endgroup$
1
  • $\begingroup$ nice..."lucky" to "unlucky" years...but which are which?...now off to count some black cats... $\endgroup$ Commented Jul 7, 2014 at 13:04
12
$\begingroup$ 
data = Cases[DayRange[{2000, 1, 1}, {2399, 12, 31}, Friday], {y_, m_, d_} :>d] // Tally // Sort; TableForm[data[[ ;; ;; 2]], TableHeadings -> {None, {"Day", "Number of Fri."}}]

Mathematica graphics

(Reverse@SortBy[data, Last])[[;; 5]] 
{{27, 688}, {20, 688}, {13, 688}, {6, 688}, {25, 687}}
Improve this answer
$\endgroup$
4
  • $\begingroup$ Thanks, very nice and simple answer! This gives me the result that Fridays are most likely to be 6th, 13th, 20th, and 27th - again scary result! $\endgroup$ Commented Jul 6, 2014 at 8:01
  • 3
    $\begingroup$ @VividD If the 13th of the month is most likely to be a Friday, and a week lasts 7 days, then it's logical that the 6th, 20th and 27th will also most likely be a Friday. $\endgroup$ Commented Jul 6, 2014 at 12:36
  • $\begingroup$ @oska - thanks for editing in table & details - I had to hit the sack right after posting... $\endgroup$ Commented Jul 6, 2014 at 19:27
  • $\begingroup$ @rasher My pleasure, I just hope I didn't destroy it ;) I don't have v9 :D $\endgroup$ Commented Jul 6, 2014 at 20:20
5
$\begingroup$ 
Sort@Tally[DayRange[{2000, 1, 1}, {2399, 12, 31}, Friday][[All, 3]]] % == data (* from rasher's post *) (* True *)

or 

Tally[Sort[DayRange[{2000, 1, 1}, {2399, 12, 31}, Friday][[All, 3]]]]

or

Through[{First, Length}[#]] & /@ Split[Sort[DayRange[{2000, 1, 1}, {2399, 12, 31}, Friday][[All, 3]]]]

or

Through[{First, Length}[#]] & /@ Gather[Sort[DayRange[{2000, 1, 1}, {2399, 12, 31}, Friday][[All, 3]]]]

All give the same result.

And

Commonest[DayRange[{2000, 1, 1}, {2399, 12, 31}, Friday][[All, 3]]] (* {6, 13, 20, 27} *)
Improve this answer
$\endgroup$
0

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.