Mathematica в действии, блог Осипова Романа

Пятница, 13-е: есть ли в ней что-нибудь особенное?
Исследование, проведенное вместе с Mathematica

Нажмите, чтобы скачать данный пост в виде ноутбука Mathematica...

Общее количество использованных в посте встроенных функций или символов: 64

Список имен используемых встроенных функций и символов в порядке их появления в коде:
DateDifference | DateString | List ({...}) | Row | If | Equal (==) | CompoundExpression (;) | Set (=) | SetOptions | BarChart | Rule (->, ->) | ChartLabels | Map (/@) | Function (&) | Style | Slot (#) | Bold | ImageSize | ColorFunction | ColorData | TicksStyle | Directive | AxesStyle | Thick | GridLinesStyle | Dashed | Table | Tally | Labeled | Part ([[…]]) | Sort | ReplaceAll (/.) | Thread | Range | Less (<) | Span (;;) | All | Ticks | Automatic | Manipulate | Red | SetDelayed (:=) | Pattern (:) | Blank (_) | Flatten | Position | Total | Abs | Plus (+) | Times (*, ×) | PlotRange | GridLines | None | PlotRangePadding | Length | Grid | Join | Background | LightOrange | LightGreen | LightYellow | Frame | ItemStyle | Power (^)

Недавно была пятница, 13-е Июля 2012 г. Этот пост готовился к ней, но так получилось, что опубликовать его именно в пятницу, 13-е не удалось.

Узнать сколько дней назад было 13.07.2012 г. в Mathematica можно с помощью функции  DateDifference следующим образом:

In[1]:=

DateDifference["13.07.2012", DateString[{"Day", ".", "Month", ".", "Year"}], "Day"]

Out[1]=

Узнать, какое сегодня число, день недели, месяц и год, в Mathematica можно с помощью функции DateString:

In[2]:=

DateString[{"День недели: ", "DayName", "\nЧисло: ", "Day", "\nМесяц: ", "MonthName", "\nГод: ", "Year"}]

Out[2]=

Проверить, является ли сегодняшний день пятницей, 13-е, можно так:

In[3]:=

Row[{"— Сегодня пятница, 13-е?\n— ", If[DateString[{"DayName", " ", "Day"}] == "Friday 13", "Да", "Нет"]}]

Out[3]=

Вспомогательный код

Введем список дней недели в том порядке, как они следуют, это понадобится нам для упрощения кода в будущем:

In[4]:=

daysOfWeek = {"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Sunday", "Saturday"} ;

А также настроим опции по умолчанию функции BarChart:

In[5]:=

SetOptions[BarChart, ChartLabels-> (Style[#, Bold, 12] &/@daysOfWeek), ImageSize->500, ColorFunction->Function[{height}, ColorData["TemperatureMap"][height]], TicksStyle->Directive[Bold, 12], AxesStyle->Thick, GridLinesStyle->Dashed] ;

Тест 1На какие дни недели выпадало и выпадет 13-е число месяца в течении 2012-го года?

Выясним, на какие дни недели выпадала и выпадет пятница, 13-е в течении 2012 г. Сделать это можно так:

выясним какой день недели соответствовал каждому 13-му числу каждого месяца:

In[6]:=

Table[DateString[{2012, monthNumber, 13}, {"DayName"}], {monthNumber, 1, 12}]

Out[6]=

определим количество встреч каждого из дней недели с помощью функции Tally:

In[7]:=

Tally[Table[DateString[{2012, monthNumber, 13}, {"DayName"}], {monthNumber, 1, 12}]]

Out[7]=

отсортируем их по порядку следования дней недели и построим гистограмму:

In[8]:=

Labeled[Style["Распределение 13-х чисел месяцев 2012-г. по дням недели"], BarChart[Sort[Tally[Table[DateString[{2012, monthNumber, 13}, {"DayName"}], {monthNumber, 1, 12}]/.Thread[daysOfWeek->Range[7]]], #1[[1]] <#2[[1]] &][[;;, 2]], Ticks-> {Automatic, {1, 2, 3}}]]

Out[8]=

Из гистограммы видно, что в 2012 г. 13-е число месяца чаще всего является пятницей.

Тест 2На какие дни недели выпадало и выпадет 13-е число месяца в течении некоторого произвольного года?

Выясним, на какие дни недели выпадала (или выпадет) пятница, 13-е в течении некоторого произвольного года. Сделать это можно так:

In[9]:=

Manipulate[Labeled[Style[Row[{"Распределение 13-х чисел месяцев\n", Style[yearNumber, Red], " г. по дням недели"}], 20, Bold], BarChart[Sort[Tally[Table[DateString[{yearNumber, monthNumber, 13}, {"DayName"}], {monthNumber, 1, 12}]/.Thread[daysOfWeek->Range[7]]], #1[[1]] <#2[[1]] &][[;;, 2]], Ticks-> {Automatic, {1, 2, 3}}]], {{yearNumber, 2013, "Год: "}, 0, 10000, 1}]

Out[9]=

Из манипулятора видно, что совершенно не обязательно, что 13-е число месяца обязано чаще выпадать на пятницу в течение года.

Тест 3Действительно ли чаще всего 13-е число месяца является пятницей?

Известно, что Григорианский календарь имеет период повторения, длина которого составляет 400 лет.

Убедиться в этом можно следующим образом (на основе распределения пятниц, 13-е по месяцам в году):

Возьмем последовательность номеров месяцев, в которых 13-е число является пятницей, начиная с года m и заканчивая годом n:

In[10]:=

Friday13MonthNumbers[nYear_, mYear_] := Flatten @ Table[Position[Table[DateString[{yearNumber, monthNumber, 13}, {"DayName"}], {monthNumber, 1, 12}], "Friday"], {yearNumber, nYear, mYear}]

Скажем, в 2012 г. с помощью этой функции мы получаем, что пятница 13-е выпадет на 1, 4 и 7 месяцы, действительно:

In[11]:=

Friday13MonthNumbers[2012, 2012]

Out[11]=

А в период с 2013 по 2020 на следующие месяцы:

In[12]:=

Friday13MonthNumbers[2013, 2020]

Out[12]=

Теперь найдем члены этой последовательности для годов 0,1,...,399;
400,401,...,799;
800,801,...,1199; ...
(получим несколько подпоследовательностей, содержащих по 400 членов каждая) и покажем что все эти подпоследовательности одинаковые:

In[13]:=

period = Friday13MonthNumbers[0, 399] ; Table[Total[Abs[period - Friday13MonthNumbers[400i, 400i + 399]]], {i, 1, 20}]

Out[13]=

Теперь выясним, на какой день недели чаще всего выпадает 13-число в течение одного периода Григорианского календаря:

In[14]:=

Labeled[Style["Распределение 13-х чисел месяцев по дням недели\n(в течение одного периода Григорианского календаря)"], BarChart[Sort[Tally[Flatten @ Table[DateString[{yearNumber, monthNumber, 13}, {"DayName"}], {yearNumber, 0, 399}, {monthNumber, 1, 12}]/.Thread[daysOfWeek->Range[7]]], #1[[1]] <#2[[1]] &][[;;, 2]], Ticks-> {Automatic, {684, 685, 687, 688}}, PlotRange-> {680, 690}, GridLines-> {None, {684, 685, 687, 688}}, PlotRangePadding-> {{0, 0}, {1, 0}}]]

Out[14]=

Таким образом, получается что действительно, 13-е число месяца выпадает на пятницу чаще, чем на другие дни недели, хотя выпадает всего на 1 день чаще в течение 400 лет, чем, скажем, на среду или субботу.

Тест 4Сколько раз в году встречается пятница, 13-е?

Немного модифицируем функцию Friday13MonthNumbers, чтобы она выдавала количество пятниц, в заданном году:

In[15]:=

NumberOfFriday13InYear[nYear_] := Length @ Position[Table[DateString[{nYear, monthNumber, 13}, {"DayName"}], {monthNumber, 1, 12}], "Friday"]

Теперь найдем последовательность, которая содержит все возможные количества пятниц, 13-е в году, с учетом периода Григорианского календаря и определим доли всех возможных количеств встреч пятниц, 13-е, после чего построим таблицу:

In[16]:=

Grid[{{"Количество\nпятниц, 13-е\nв году", "Количество лет, в которых\nстолько раз встречается\nпятница, 13-е"}} ~ Join ~ Tally[Table[NumberOfFriday13InYear[nYear], {nYear, 0, 399}]], Background-> {None, {LightOrange, {LightGreen, LightYellow}}}, Frame->All, ItemStyle->Bold]

Out[16]=

Из таблицы видно, что с почти равной вероятностью год будет иметь одну или две пятницы, 13-е, и с заметно меньшей вероятностью будет иметь три пятницы, 13-е, причем более трех пятниц, 13-е в году быть не может.

Тест 4На какой месяц чаще выпадает пятница, 13-е?

Возьмем последовательность номеров месяцев, в которых 13-е число является пятницей, начиная с 0 года и заканчивая 399 годом (один период календаря) и построим гистограмму, показывающую количество встреч каждого из месяцев в этой последовательности:

In[17]:=

Labeled[Style["Распределение пятниц, 13-е по месяцам\n(в течение одного периода Григорианского календаря)"], BarChart[Sort[Tally[Friday13MonthNumbers[0, 399]], #1[[1]] <#2[[1]] &][[;;, 2]], Ticks-> {Automatic, {56, 57, 58}}, PlotRange-> {55, 59}, GridLines-> {None, {56, 57, 58}}, PlotRangePadding-> {{0, 0}, {1/2, 0}}, ChartLabels-> (Style[#, Bold, 12] &/@Range[12])]]

Out[17]=

Из гистограммы видно, что пятница, 13-е выпадает на каждый из месяцев примерно с равной вероятностью, хотя она реже всего встречается в Августе и Октябре.

Блог принадлежит “Русскоязычной поддержке Wolfram Mathematica"©
При любом использовании материалов блога, ссылка на блог обязательна.
Создано с помощью Wolfram Mathematica 8