{Программа для определения физической, эмоциональной и интеллектуальной
активности человека. Вводится дата рождения и текущая дата. Программа
вычисляет и выводит на экран общее количество дней, часов, минут и секунд,
разделяющих обе даты, а также прогнозирует на месяц вперед даты,
соответствующие максимуму и минимуму биоритмов.
Описание программы см. п.2.7.2. книги 1}
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,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 (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 (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
   else {Даты отличаются не только днями:}
    begin
      days := d + Size_of_Month[m0] - d0;
      {Учитываем количество дней в текущем месяце  и
       количество дней до конца месяца рождения}
      if (y0 mod 4 = 0) and (m0 = 2) then 
	  inc(days); {Учитываем високосный год}
      if y = 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; {Период физической активности}
   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
       else 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 [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: LongInt; {"Длинная" целая переменная для часов,
                      минут и секунд }
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,y);
  Get_numbers_of_days(d0,m0,y0,d,m,y,days);
  FindMaxMin(dmin,dmax,days);
  WriteDates(dmin,dmax,days)
end.