Определение биоритмов
{Программа для определения физической, эмоциональной и интеллектуальной активности человека. Вводится дата рождения и текущая дата. Программа вычисляет и выводит на экран общее количество дней, часов, минут и секунд, разделяющих обе даты, а также прогнозирует на месяц вперед даты, соответствующие максимуму и минимуму биоритмов. Описание программы см. п. 2. 7. 2.}
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 =1800; {Минимальный правильный год}
YMAX =2000; {Максимальный правильный год}
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, у);
{Проверяем непротиворечивость дат:}
correctly := у > у0;
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_number s_of_days (d0,m0, y0,d,m, у : 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 (y0 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 (yO mod 4=0) then
inc (days) ;
inc (mm)
end;
yy := y0 + 1;
while yy < у 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
else {Даты отличаются не только днями: }
begin
days := d + Size_of_Month[m0] - d0;
{Учитываем количество дней в текущем месяце и количество дней
до конца месяца рождения}
if (y0 mod 4=0) and (m0 = 2) then
inc (days) ; {Учитываем високосный год}
if у = y0 then
Variant2 {Разница в месяцах одного и того же года}
else
Variant3 {Даты отличаются годами}
end
end; {Get_numbers_of_days}
{-------------------}
Procedure FindMaxMin(var dmin, dmax: Integer; days: Integer) ;
{Поиск критических дней}
const
TF = 2*3.1416/23.6884; {Период физической активности}
ТЕ = 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
else
if x < min then
begin
min := x;
dmin := days + i
end
end;
end; {FindMaxMin}
{----------------}
Procedure WriteDates (dmin, dmax, days : Integer);
{Определение и вывод дат критических дней. Вывод дополнительной
информации о количестве прожитых дней, часов, минут и секунд }
{-------------}
Procedure WriteDatettext: String; dd: Integer);
{Определение даты для дня DD от момента рождения. В глобальных
переменных d, m и у имеется текущая дата, в переменной DAYS -
количество дней, прошедших от момента рождения до текущей даты.
Выводится сообщение TEXT и найденная дата в формате ДД-МЕС-ГГГГ}
const
Names_of_Monthes : array [1..12] of String [3] = ( ' янв ' , ' фев ' , ' мар ' , ' апр ' , ' мая '' июн ',
' июл ' , ' авг ' , ' сен ' , ' окт ' , ' ноя ',' дек ' ) ;
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: Longlnt; {"Длинная" целая переменная для часов,
минут и секунд }
begin {WriteDates}
LongDays := days;
WriteLn ( ' Пропшо : ', LongDays,' дней, ' , longDays*24,
' часов, ',LongDays*24*60,'минут,',LongDays*24*60*60,'секунд');
WriteDate (' Наименее благоприятный день: ',dmin);
WriteDate ( 'Наиболее благоприятный день: ',dmax)
end ; { WriteDates}
{------------------}
begin {Главная программа}
InputDates (d0,m0,y0,d, m, у) ;
Get_numbers_of_days (d0,m0,y0,d,m,y,days) ;
FindMaxMin (dmin, dmax, days) ;
WriteDates (dmin, dmax, days)
end .
