Type
td = 1..31;
tm = 1..12;
ty = 1..2000;
Date = record
d: td;
m: tm;
y: td
end;
dw = (Pn, Vt, Sr, Cht, Pt, Sb, Vs);
function jday(pd: Date): longint;
{
Алгоритм 199б
"Переход от календарной даты к порядковому номеру дня и обратно"
Взят из сборника "Библиотека алгоритмов 151б-200б",
М.И.Агеев и др., М.: Радио и связь, 1981
Алгоритм возвращает порядковый номер дня по Юлианскому календарю.
Работает для дат, начиная с 01.01.4713 до н.э.
Переработан с языка Algol-60 на Паскаль.
}
var
c, ya: longint;
begin
with pd do
begin
if m > 2 then m := m - 3
else
begin
m := m + 9;
y := y - 1
end;
c := y div 100;
ya := y mod 100;
Result := ((146097 * c) div 4) + ((1461 * ya) div 4) +
((153 * m + 2) div 5) + d + 1721119
end;
end;
function IsFriday(pd: Date): boolean;
{
Возвращает true, если день - пятница
Использует формулу Ж.Скалигера - С.Дроздова,
получающую номер дня в неделе по номеру юлианского дня.
}
var
n: integer;
begin
n := jday(pd);
n := jday(pd) mod 7;
IsFriday := (n = Ord(Pt))
end;
function nBlackFridayYear(n: integer): integer;
{ Возвращает количество "черных пятниц" в заданном году }
var
i, s: integer;
dt: Date;
begin
dt.d := 13; dt.y := n;
s := 0;
for i := 1 to 12 do
begin
dt.m := i;
if IsFriday(dt) then s := s + 1
end;
nBlackFridayYear := s
end;
function nBlackFridayYearC(d, m, y: integer): integer;
{
Возвращает количество "черных пятниц" в заданном году для дат,
не превышающих заданной.
}
var
i, s: integer;
dt: Date;
begin
d := dt.d; dt.d := 13;
s := 0;
for i := 1 to m - 1 do
begin
dt.m := i;
if IsFriday(dt) then s := s + 1
end;
if d = 13 then
begin
dt.m := m;
if IsFriday(dt) then s := s + 1
end;
nBlackFridayYearC := s
end;
{ Основная часть }
var
d, m, y, i, n, s: integer;
begin
Write('Введите через пробел день, месяц, год ->');
Readln(d, m, y);
{ Определим количество "черных" пятниц за предшествующие годы }
s := 0;
for i := 1 to y - 1 do s := s + nBlackFridayYear(i);
{ Добавим количество "черных" пятниц в заданном году }
s := s + nBlackFridayYearC(d, m, y);
Writeln('Количество "черных" пятниц равно ',s)
end.
Тестовое решение:
Введите через пробел день, месяц, год ->15 6 1987
Количество "черных" пятниц равно 3417
ЗАМЕЧАНИЕ. Поскольку Паскаль по умолчанию не проверяет, находится ли значение интервального типа в заданном интервале, данная программа принимает любые даты и всегда производит правильный подсчет.