Описание и задача
Современные системы управления базами данных поддерживают широкий класс различных операций с датами. Для решения этой задачи Вы должны написать программу, реализующую некоторые из таких операций. Ваша программа должна обрабатывать выражения следующих типов:

  • <Дата>

  • <Дата> + <Сдвиг>

  • <Дата> - <Сдвиг>

  • <Дата> - <Дата>


Здесь <Дата> задается в одном из следующих трех форматов:

  1. дд.мм.гггг (например, 21.06.1998). В этой записи день и месяц задаются в точности двумя десятичными цифрами, год - ровно четырьмя

  2. д месяца г года (например, 21 июня 1998 года). В этом формате могут присутствовать ведущие нули (например, 01 июня 198 года)

  3. сегодня - текущая дата, установленная в компьютере


<Сдвиг> задается в виде [L лет] [M месяцев] [N недель] [D дней]. Квадратные скобки здесь означают, что некоторые из указанных четырех составных частей могут опускаться (но не все сразу). Слова "лет", "месяцев", "недель", "дней" склоняются по правилам русского языка: 1 год, 5 лет, 2 месяца, 5 месяцев и т.д.

Значением выражений первых трех типов является дата. В случае выражения первого типа значением является сама <Дата>. В случае выражений второго и третьего типа вычисление искомой даты происходит следующим образом: сначала прибавляется (либо вычитается) L лет, затем M месяцев, после чего N недель и, наконец, D дней. Если в течение этого процесса получается несуществующее число месяца, то берется последнее число этого месяца (см. пример). Результатом выражения четвертого типа является количество дней между двумя указанными датами


Входные данные
Входной файл содержит последовательность выражений, каждое из которых записано в отдельной строке. Большие и маленькие буквы в выражениях не различаются

Выходные данные
Для заданных выражений требуется вывести в выходной файл их значения в том же порядке, в котором указаны выражения. Для выражений первых трех типов нужно выдать дату в формате (B), а затем через запятую указать день недели, соответствующий этой дате. Для выражений четвертого типа необходимо вывести одно целое число. Каждое значение выводится в отдельную строку выходного файла


Например:

CALCDATE.IN
30 января 1998 года + 1 месяц 1 день
21 июня 1998 года - 1.06.1998

CALCDATE.OUT
1 марта 1998 года, воскресенье
20






Комментарии
Задача авторами не комментировалась

 



 Решение

{$A+,B-,D+,E-,F-,G+,I-,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,655360}
 
program calcdate;
uses dos;
type integer = longint;
     TData =
        record
          dd, mm, YY: longint;
        end;
var i: integer;d: TData;
 
procedure RemoveSpaces (var s: string);
var s1: string;
    i: integer;
begin
  s1 := '';
  for i := 1 to byte(s[0]) do
    if s[i] <> ' ' then s1 := s1 + s[i];
  s := s1;
end;
 
function c2b (c: char): byte;
begin
  c2b := byte (c) - $30;
end;
 
function GetNumber (s: string; p: integer): longint;
var i, j: integer;
    b, l: longint;
begin
  if p = 0 then begin GetNumber := 0; exit; end;
  i := p;
  while (i > 0) and (not (s[i] in ['0'..'9'])) do dec (i);
  if i = 0 then begin GetNumber := 0; exit; end;
  l := 0; b := 1;
  while (i > 0) and (s[i] in ['0'..'9']) do
  begin
    l := l + c2b(s[i]) * b;
    b := b * 10;
    dec (i);
  end;
   GetNumber := l;
end;
 
const mon: array [1..12] of string [30] =
('января','февраля','марта','апреля','мая','июня','июля','августа','сентября',
 'октября','ноября','декабря');
      day: array [1..7] of string [30] =
('понедельник','вторник','среда','четверг','пятница','суббота','воскресенье');
MonLen: array [1..12] of integer =
(31,28,31,30,31,30,31,31,30,31,30,31);
      RLow  : string = 'абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
      RHigh : string = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
 
procedure RUpCase (var s: string);
var i, j: integer;
begin
  for i := 1 to length (s) do
  begin
    for j := 1 to 33 do
      if s[i] = Rlow[j] then s[i] := RHigh[j];
  end;
end;
 
procedure GetData (s: string; var d: TData);
var y1, m1, d1, w1: word;
    i, j: integer;
    s1: string;
begin
  d. YY := 0; d. mm := 0;d.dd := 0;
  if pos ('СЕГОДНЯ', s) > 0 then
    begin
      GetDate (y1, m1, d1, w1);
      d. YY := y1;
      d. mm := m1;
      d. dd := d1;
      exit;
    end;
  if pos ('.', s) > 0 then
    begin
      RemoveSpaces (s);
      d.dd := c2b (s[1]) * 10 + c2b (s[2]);
      d.mm := c2b (s[4]) * 10 + c2b (s[5]);
      d.YY := c2b (s[7]) * 1000 + c2b (s[8]) * 100 +
              c2b (s[9]) * 10 + c2b (s[10]);
      exit;
    end;
  RemoveSpaces (s);
  i := 1;
  while s[i] in ['0'..'9'] do inc (i);
  d. dd := GetNumber (s, i);
  d. YY := GetNumber (s, length (s));
  for i := 1 to 12 do
  begin
    s1 := Mon [i]; RUpCase (s1);
    if pos (s1, s) > 0 then d. mm := i;
  end;
end;
 
function Visoc (a: integer): boolean;
begin
  Visoc := false;
  if a mod 4 = 0 then
    begin
      if a mod 400 = 0 then Visoc := true;
      if a mod 100 <> 0 then Visoc := true;
    end;
end;
 
function LenYear (a: integer): integer;
begin
  if Visoc (a) then LenYear := 366 else LenYear := 365;
end;
 
function GetDayFromData (var d:TData): longint;
var i, l: longint;
begin
 l := 365 * (d.YY-1);
 l := l + ((d.YY-1) div 4);
 l := l - ((d.YY-1) div 100);
 l := l + ((d.YY-1) div 400);
 if Visoc (d.YY) then if d. mm > 2 then l := l + 1;
 for i := 1 to d.mm - 1 do
   l := l + MonLen [i];
 l := l + d.dd;
 GetDayFromData := l-1;
end;
 
procedure MakeDataFromDay (l: longint; var d: TData);
var i, j: longint;
begin
  d. YY := 0;
  d. mm := 0;
  d. dd := 0;
  while l >= 146097 do
    begin
      d. YY := d. YY + 400;
      dec (l, 146097);
    end;
  while l >= LenYear (d.YY+1) do
  begin
    dec (l, LenYear (d.YY+1));
    inc (d.YY);
  end;
  if Visoc(d.YY+1) then MonLen [2] := 29;
  while l >= MonLen [d.mm+1] do
  begin
    dec (l, MonLen [d.mm+1]);
    inc (d.mm);
  end;
  monlen [2] := 28;
  d.YY := d. YY + 1;
  d.mm := d.mm + 1;
  d.dd := l + 1;
end;
 
function GetDayOfWeek (var d: TData): integer;
begin
 GetDayOfWeek := ((GetDayFromData(d)) mod 7) + 1;
end;
 
procedure PrintData (var d: TData);
begin
  writeln (d.dd, ' ', mon [d.mm],' ',d.YY, ' года,', day [GetDayOfWeek (d)]);
end;
 
procedure GetShift (s: string; var d: TData);
var y1, m1, d1, w1: integer;
    y2, m2, d2, w2: longint;
begin
  d1 := pos ('ДН', s);
  if d1 = 0 then d1 := pos ('ДЕН', s);
  m1 := pos ('МЕС', s);
  w1 := pos ('НЕД', s);
  y1 := pos ('ГОД', s);
  if y1 = 0 then y1 := pos ('ЛЕТ', s);
  d.YY := GetNumber (s, y1);
  d.mm := GetNumber (s, m1);
  d.dd := GetNumber (s, w1) * 7 + GetNumber (s, d1);
end;
 
procedure MakeGoodData (var d: TData);
var ml: longint;
begin
  ml := MonLen [d.mm];
  if (d.mm = 2) and (Visoc (d.YY)) then inc (ml);
  if d.dd > ml then d.dd := ml;
end;
 
procedure AddDataShift (var d1, d2, d: TData);
var l: longint;
begin
  d. YY := d1. YY + d2. YY + d2.mm div 12;
  d. mm := d1. MM + (d2. MM mod 12);
  while d.mm > 12 do
  begin
    dec (d. mm, 12);
    inc (d. YY, 1);
  end;
  d. dd := d1. dd;
  MakeGoodData (d);
  l := GetDayFromData (d);
  l := l + d2. dd;
  MakeDataFromDay (l, d);
end;
 
procedure SubDataShift (var d1, d2, d: TData);
var l: longint;
begin
  d. YY := d1. YY - d2. YY - d2.mm div 12;
  d. mm := d1. MM - (d2. MM mod 12);
  while d.mm < 1 do
  begin
    inc (d. mm, 12);
    dec (d. YY, 1);
  end;
  d. dd := d1. dd;
  MakeGoodData (d);
  l := GetDayFromData (d);
  l := l - d2. dd;
  MakeDataFromDay (l, d);
end;
 
function IsData (s: string): boolean;
begin
  IsData := false;
  if Pos ('.', s) > 0 then IsData := true;
  if Pos ('СЕГОДНЯ', s) > 0 then IsData := true;
  if Pos ('ЯНВ', s) > 0 then IsData := true;
  if Pos ('ФЕВ', s) > 0 then IsData := true;
  if Pos ('АПР', s) > 0 then IsData := true;
  if Pos ('МА', s) > 0 then IsData := true;
  if Pos ('ИЮ', s) > 0 then IsData := true;
  if Pos ('АВГ', s) > 0 then IsData := true;
  if Pos ('СЕНТ', s) > 0 then IsData := true;
  if Pos ('ОКТЯ', s) > 0 then IsData := true;
  if Pos ('НОЯ', s) > 0 then IsData := true;
  if Pos ('ДЕКА', s) > 0 then IsData := true;
end;
 
procedure ProcessOne;
var s, s1, s2: string;
    d, d1, d2: TData;
    i, j: integer;
    l1: longint;
begin
  readln (input, s);
  RUpCase (s);
  if (pos ('-', s) = 0) and (pos ('+', s) = 0) then
         begin
           GetData (s, d);
           PrintData (d);
           exit;
         end;
  if (pos ('+', s) > 0) then
         begin
           i := pos ('+', s);
           s1 := copy (s, 1, i-1);
           s2 := copy (s, i+1, 255);
           GetData (s1, d1);
           GetShift (s2, d2);
           AddDataShift (d1, d2, d);
           PrintData (d);
           exit;
         end;
  i := pos ('-', s);
  s1 := copy (s, 1, i-1);
  s2 := copy (s, i+1, 255);
  GetData (s1, d1);
  if IsData (s2) then
      begin
        GetData (s2, d2);
        writeln (GetDayFromData (d1) - GetDayFromData (d2));
        exit;
      end;
  GetShift (s2, d2);
  SubDataShift (d1, d2, d);
  PrintData (d);
end;
 
begin
  assign (input, 'calcdate.in');  reset (input);
  assign (output,'calcdate.out'); rewrite (output);
   while not SeekEof (input) do
     ProcessOne;
  close (output);
  close (input);
end.

 

© Особенности национальных задач по информатике