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

Статьи

Ближайшая пятница 13-е будет 13-го сентября 2019 г.

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

In[1]:=
DateDifference[Now,DateObject[{2019,9,13,0,0,0}],"Day"]

Out[1]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

Out[2]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

Out[3]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

In[4]:=
daysOfWeek={Monday,Tuesday,Wednesday,Thursday,Friday,Sunday,Saturday};

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

In[5]:=

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

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

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

  • выясним какой день недели соответствовал каждому 13-му числу каждого месяца:
In[6]:=
Table[DayName@DateObject[{19,monthNumber,13}],{monthNumber,1,12}]

Out[6]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

  • определим количество встреч каждого из дней недели с помощью функции Tally:
In[7]:=
Tally[
    Table[DayName@DateObject[{19,monthNumber,13}],{monthNumber,1,12}]
]

Out[7]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

  • отсортируем их по порядку следования дней недели и построим гистограмму:
In[8]:=
BarChart[    
    Sort[        
        Tally[            
            Table[                
                DayName@DateObject[{19,monthNumber,13}],
                {monthNumber,1,12}
            ]
            /.
            Thread[daysOfWeek->Range[7]]
        ],
        #1[[1]]<#2[[1]]&
    ][
        [;;,2]
    ],
    Ticks->{Automatic,{1,2,3}},
    PlotLabel->
        TextCell[            
            "Распределение 13-х чисел\nмесяцев 2019 г. по дням недели",
            FontFamily->"Open Sans Light",
            25,
            TextAlignment->Left
        ]
]

Out[8]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

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

In[9]:=
Table[DayName@DateObject[{2019,monthNumber,13}],{monthNumber,1,12}]

Out[9]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

In[10]:=
Manipulate[    
    BarChart[        
        Sort[            
            Tally[                
                Table[                    
                    DayName@DateObject[{yearNumber,monthNumber,13}],
                    {monthNumber,1,12}
                ]
                /.
                Thread[daysOfWeek->Range[7]]
            ],
            #1[[1]]<#2[[1]]&
        ][
            [;;,2]
        ],
        Ticks->{Automatic,{1,2,3}},
        PlotLabel->
            TextCell[                
                Row[
                    {                        
                        "Распределение 13-х чисел месяцев\n",
                        Style[yearNumber,Red],
                        " г. по дням недели"
                    }
                ],
                FontFamily->"Open Sans Light",
                25,
                TextAlignment->Left
            ]
    ],
    {{yearNumber,2019,"Год: "},0,10000,1}
]

Out[10]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

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

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

  • Возьмем последовательность номеров месяцев, в которых 13-е число является пятницей, начиная с года m и заканчивая годом n:
In[11]:=
Friday13MonthNumbers[nYear_,mYear_]:=
    Flatten@
        Table[            
            Position[                
                Table[                    
                    DayName@DateObject[{yearNumber,monthNumber,13}],
                    {monthNumber,1,12}
                ],
                Friday
            ],
            {yearNumber,nYear,mYear}
        ]

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

In[12]:=
Friday13MonthNumbers[2019,2019]

Out[12]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

In[13]:=
Friday13MonthNumbers[2019,2029]

Out[13]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

Out[14]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

Таким образом, мы подтвердили, что период повторения Григорианского календаря составляет 400 лет.

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

In[15]:=
BarChart[    
    Sort[        
        Tally[            
            Flatten@
                Table[                    
                    DayName@DateObject[{yearNumber,monthNumber,13}],
                    {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}},
    PlotLabel->
        TextCell[            
            "Распределение пятниц, 13-е по месяцам\n(в течение одного периода Григорианского календаря)",
            FontFamily->"Open Sans Light",
            25,
            TextAlignment->Left
        ]
]

Out[15]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

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

In[16]:=
NumberOfFriday13InYear[nYear_]:=
    Count[        
        Table[            
            DayName@DateObject[{nYear,monthNumber,13}],
            {monthNumber,1,12}
        ],
        Friday
    ]

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

In[17]:=
Grid[        
    {        
        TextCell[#,FontFamily->"Open Sans Light",16,TextAlignment->Left]&/@
            {                
                "Количество пятниц, 13-е в году",
                "Количество лет, в которых столько раз встречается пятница, 13-е"
            }
    }
    ~
    Join
    ~
    Tally[Table[NumberOfFriday13InYear[nYear],{nYear,0,399}]],
    Background->{None,{LightOrange,{LightGreen,LightYellow}}},
    Frame->All,
    ItemStyle->Bold,
    ItemSize->{{20,20},Automatic}
]

Out[17]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

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

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

In[18]:=
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]),
    PlotLabel->
        TextCell[            
            "Распределение пятниц, 13-е по месяцам\n(в течение одного периода Григорианского календаря)",
            FontFamily->"Open Sans Light",
            25,
            TextAlignment->Left
        ]
]

Out[18]=
Пятница, 13-е: есть ли в ней что-нибудь особенное? Исследование, проведенное вместе с <em>Mathematica</em>

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

Оценить статью
Блог о Wolfram Mathematica

Оставить комментарий

avatar
  Подписаться  
Уведомление о