на месяц вперед даты, соответствующие максимуму и минимуму биоритмов}
CONST
SIZE_OF_MONTH: ARRAY [1..12] OF BYTE=
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var
d0,d, {Дни рождения и месяцы}
m0,m, {Месяцы рождения и текущий}
y0,y, {Годы рождения и текущий}
dmin, {Наименее благоприятный день}
dmax, {Наиболее благоприятный день}
days: integer; {Количество дней от рождения}
{------------------------------------------------}
PROCEDURE InputDates (var d0,m0,y0,d,m,y: integer);
{Ввод даты рождения и текущей даты.
Контроль правильности дат и их непротиворечивости
(текущая дата должна быть позже даты рождения)}
var
correctly: boolean; {Признак правильности ввода}
{-----------------------------------------------}
PROCEDURE InpDate (text: string;
var d,m,y: integer);
{Выводит приглашение TEXT, вводит дату в формате
ДД ММ ГГГГ и проверяет ее правильность}
const
YMIN=1900; {Минимальный правильный год}
YMAX=2100; {Максимальный правильный год}
BEGIN {InpDate}
repeat
write (text);
readln(d,m,y);
correctly:=(y>=YMIN) and (y<=YMAX) and (m>=1)
and (m<=12) and (d>0);
if correctly then
if (m=2) and (d=29) and (y mod 4=0) then
{ничего не делать: это 29 февраля високосного года}
else
correctly:=d<=Size_of_Month[m];
if not correctly then
writeln('ВНИМАНИЕ! Ошибка в дате!');
until correctly
end; {InpDate}
{--------------------------------}
BEGIN {InputDates}
repeat
InpDate(' Введите дату рождения в формате ДД ММ ГГГГ: ',
d0,m0,y0);
InpDate(' Введите текущую дату в формате ДД ММ ГГГГ: ',
d,m,y);
correctly:=y>y0; {ПРоверить непротиворечивость дат:}
if not correctly and (y=y0) then
begin
correctly:=m>m0;
if not correctly and (m=m0) then
correctly:=d>d0;
end;
until correctly;
END; {InputDates}
{----------------------------------------------------}
PROCEDURE Get_numbers_of_days (d0,m0,y0,d,m,y: integer;
var days: integer);
{Определение полного количества дней,
прошедших от одной даты до другой}
{----------------------------------------------------}
PROCEDURE Variant2;
{Подсчет количества дней в месяцах, разделяющих обе даты}
var
mm: integer;
BEGIN {Variant2}
mm:=m0;
while mm<m do
begin
days:=days+Size_of_Month[mm];
if (mm=2) and (m0 mod 4=0) then inc(days);
inc(mm);
end;
END; {Variant2}
{---------------------------------------------------}
PROCEDURE Variant3;
{Подсчет количества дней в месяцах, разделяющих обе даты}
var mm,yy: integer;
BEGIN {Variant3}
mm:=m0+1;
while mm<=12 do {Учесть остаток года рождения :}
begin
days:=days+Size_of_Month[mm];
if (mm=2) and (y0 mod 4=0) then inc(days);
inc(mm);
end;
yy:=y0+1;
while yy<y do {Прибавить разницу лет: }
begin
days:=days+365;
if yy mod 4=0 then inc(days);
inc(yy);
end;
mm:=1;
while mm<m do {Прибавить начало текущего года: }
begin
days:=days+Size_of_Month[mm];
if (y mod 4=0) and (mm=2) then inc(days);
inc(mm);
end;
END; {Variant3}
{-----------------------------------------------------}
BEGIN {Get_numbers_of_days}
if (y=y0) and (m=m0) then {Даты отличаются только днями: }
days:=d-d0;
{Даты отличаются не только днями: }
begin
days:=d+Size_of_Month[m0]-d0;
{Учесть количество дней в текущем месяце и
количество дней до конца месяца рождения}
if (y0 mod 4=0) and (m0=2) then inc(days);
{Учесть високосный год }
if y=y0 then Variant2;
{Разница в месяцах одного и того же года}
Variant3;
{Даты отличаются годами}
end;
END; {Get_numbers_of_days}
{-------------------------------------------------}
PROCEDURE FindMaxMin (var dmin,dmax: integer;
days: integer);
{Поиск критических дней }
const
TF=2*3.1416/23.6884; {Период физической активности}
TE=2*3.1416/28.4261; {Период эмоциональной активности}
TI=2*3.1416/33.1638; {Период интеллектуальной активности}
INTERVAL=30; {Интервал прогноза}
var
min,max,x:real;
i:integer;
BEGIN {FindMaxMin}
max:=sin(days*TF)+sin(days*TE)+sin(days*TI);
min:=max;
dmin:=days;
dmax:=days;
for i:=0 to INTERVAL do
begin
x:=sin((days+i)*TF)+sin((days+i)*TE)+sin((days+i)*TI);
if x>max then
begin
max:=x;
dmax:=days+i;
end;
if x<min then
begin
min:=x;
dmin:=days+i;
end;
end;
END; {FindMaxMin}
{--------------------------------------------}
PROCEDURE WriteDates(dmin,dmax,days:integer);
{Опреджеление и вывод дат критических дней.
Вывод дополнительной информации о количестве
прожитых дней, часов, минут и секунд}
{---------------------------------------------}
PROCEDURE WriteDate(text:string;
dd:integer);
{Определение даты для дня DD от монента рождения.
В глобальных переменных d,m и y имеется текущая дата,
в переменной DAYS - количество дней, прошедших от момента
рождения до текущей даты.
Выводится сообщение TEXT и найденная дата в формате
ДД-ММ-ГГГГ.}
const
Names_of_Monthes:array[1..12] of string[5]=
('янв ','февр','март','апр ','май ',
'июнь','июль','авг ','сент','окт ',
'нояб','дек ');
var
d0,m0,y0,ddd:integer;
BEGIN {WriteDate};
d0:=d;
m0:=m;
y0:=y;
ddd:=days;
while ddd<>dd do
begin
inc(d0); {Нарастить число}
if (y0 mod 4<>0) and (d0>Size_of_Month[m0]) or
(y0 mod 4=0) and (d0=30) then
begin {Корректировать месяц}
d0:=1;
inc(m0);
if m0=13 then {Корректировать год}
begin
m0:=1;
inc(y0);
end;
end;
inc(ddd);
end;
writeln(text,d0,'-',Names_of_Monthes[m0],'-',y0);
END; {WriteDate}
{-----------------------------------------------}
var
longdays: longint; {"Длинная" целая переменная
для часов, минут и секунд}
BEGIN {WriteDates}
longdays:=days;
writeln('Прошло: ',longdays,' дней, ',longdays*24,
' часов, ',longdays*24*60,' минут, ',
longdays*24*360,' секунд.');
WriteDate('Наименее благоприятный день: ',dmin);
WriteDate('Наиболее благоприятный день: ',dmax);
END; {WriteDates}
{---------------------------------------------------}
BEGIN {ГЛАВНАЯ ПРОГРАММА}
Writeln('______________________________');
Writeln(' Программа расчета благоприятных дней ');
Writeln(' Ввод данных осуществляйте через пробел ');
Writeln('Окончание ввода данных подтвердите с помощью клавиши ENTER');
InputDates(d0,m0,y0,d,m,y);
Writeln('-----------------------------------------');
Get_numbers_of_days(d0,m0,y0,d,m,y,days);
FindMaxMin(dmin,dmax,days);
WriteDates(dmin,dmax,days);
END.
9. ПРИЛОЖЕНИЕ 2. РЕЗУЛЬТАТЫ РАБОТЫ
-------------------------------------------------------------
Программа расчета благоприятных дней
Ввод данных осуществляйте через пробел
Окончание ввода данных подтвердите с помощью клавиши ENTER
--------------------------------------------------------------
Введите дату рождения в формате ДД ММ ГГГГ: 22 02 1922
Введите текущую дату в формате ДД ММ ГГГГ: 12 09 2001
Прошло: 29057 дней, 697368 часов, 41842080 минут, 251052480 секунд.
---------------------------------------------------------------
Наименее благоприятный день: 3-окт -2001
Наиболее благоприятный день: 12-сент-2001
.
[1] Йенсен К., Вирт Н. Руководство для пользователя и описание языка.
[2] Тот же