Услуги О команде Технологии Wolfram Заказчики Заказать Вебинары Блог
VK
Youtube
Instagram
Telegram
Роман Осипов

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

БЛОГ переехал на новый адрес: https://blog.wolframmathematica.ru/
Скачать пост в виде документа Wolfram Mathematica
Узнать сколько дней до 13.09.2019 г. в Mathematica можно с помощью функции  DateDifference следующим образом:
In[1]:=

 DateDifference[Now,DateObject[{2019,9,13,0,0,0}],"Day"]
Узнать, какое сегодня число, день недели, месяц и год, в Mathematica можно с помощью функции DateString:
In[2]:=

 DateString[
    {        
        "День недели: ",
        "DayName",
        "\nЧисло: ",
        "Day",
        "\nМесяц: ",
        "MonthName",
        "\nГод: ",
        "Year"
    }
]
Проверить, является ли сегодняшний день пятницей, 13-е, можно так:
In[3]:=

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

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

Введем список дней недели в том порядке, как они следуют, это понадобится нам для упрощения кода в будущем:
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 г. Сделать это можно так:
In[6]:=

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

 Tally[
    Table[DayName@DateObject[{19,monthNumber,13}],{monthNumber,1,12}]
]
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
        ]
]
Из гистограммы видно, что в 2019 г. 13-е число месяца чаще всего является вторником.

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

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

 Table[DayName@DateObject[{2019,monthNumber,13}],{monthNumber,1,12}]
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}
]
Из манипулятора видно, что совершенно не обязательно, что 13-е число месяца обязано чаще выпадать на пятницу в течение года.

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

Известно, что Григорианский календарь имеет период повторения, длина которого составляет 400 лет.
Убедиться в этом можно следующим образом (на основе распределения пятниц, 13-е по месяцам в году):
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]
А в период с 2019 по 2029 на следующие месяцы:
In[13]:=

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

 
period=Friday13MonthNumbers[0,399];
Table[Total[period-Friday13MonthNumbers[400i,400i+399]],{i,1,10}]
Таким образом, мы подтвердили, что период повторения Григорианского календаря составляет 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
        ]
]
Таким образом, получается что действительно, 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}
]
Из таблицы видно, что с почти равной вероятностью год будет иметь одну или две пятницы, 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
        ]
]
Из гистограммы видно, что пятница, 13-е выпадает на каждый из месяцев примерно с равной вероятностью, хотя она реже всего встречается в Августе и Октябре.
Список имен используемых встроенных функций и символов в порядке их появления в коде:
DateDifference, Now, DateObject, List ({...}), DateString, Row, If, SameQ (===), DateValue, Friday, CompoundExpression (;), Set (=), Monday, Tuesday, Wednesday, Thursday, Sunday, Saturday, SetOptions, BarChart, Rule (->, ->), ChartLabels, Map (/@), Function (&), Style, Slot (#), Bold, ImageSize, ColorFunction, ColorData, TicksStyle, Directive, AxesStyle, Thick, GridLinesStyle, Dashed, Table, DayName, Tally, Part ([[\[Ellipsis]]]), Sort, ReplaceAll (/.), Thread, Range, Less (<), Span (;;), All, Ticks, Automatic, PlotLabel, TextCell, FontFamily, TextAlignment, Left, Manipulate, Red, SetDelayed (:=), Pattern (:), Blank (_), Flatten, Position, Total, Plus (+), Times (*, *), PlotRange, GridLines, None, PlotRangePadding, Count, Grid, Join, Background, LightOrange, LightGreen, LightYellow, Frame, ItemStyle, ItemSize, Power (^)
Вебинары о технологиях Wolfram | СКОРО
Каждую неделю мы будем проводить вебинар о применении технологий Wolfram.

Мы будем собираться с вами на удобной онлайн-площадке и обсуждать самые разные вопросы программирования на языке Wolfram Language. Решать задачи в реальном времени и вы сможете, конечно, задавать вопросы.