IPB
ЛогинПароль:

> Внимание! Действует предмодерация

Подраздел FAQ (ЧАВО, ЧАстые ВОпросы) предназначен для размещения готовых рабочих программ, реализаций алгоритмов. Это нечто вроде справочника, он наполнялся в течение 2000х годов. Ваши вопросы, особенно просьбы решить задачу, не пройдут предмодерацию. Те, кто наполнял раздел, уже не заходят на форум, а с теми, кто на форуме сейчас, лучше начинать общение в других разделах. В частности, решение задач — здесь.

 
 Ответить  Открыть новую тему 
> Задачи связанные с календарем., по материалам нашего форума
сообщение
Сообщение #1


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


1) Как вычислить конечную дату ?
Задача: У Васи Пупкина неожиданно сломался компьютер. Из-за отсутствия нужных материалов на ремонт понадобится N дней. Определите дату окончания ремонта, если известно, что компьютер сломался в текущем году, и ремонт должен закончиться тоже в этом году...
Function GetInteger(s: String): Integer;
Var i, Err: Integer;
Begin
If s[1] = '0' Then Delete(s, 1, 1);
Val(s, i, Err); GetInteger := i
End;

Const
CurrYear = 2004;
DayInMonth: Array[1 .. 12] Of Byte =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

(*
{ Тестировалось с этими данными }
Const
Repair: Integer = 50;
st: String = '21.06';
*)
Var
Day, Month, DaysBefore: Integer;
p, i: Byte;
Var
Repair: Integer;
st: String;
begin
Inc(DayInMonth[2], Byte((CurrYear mod 4) = 0) and
not (((CurrYear mod 100) = 0) and ((CurrYear mod 400) <> 0));
Write('Дата поломки > '); ReadLn(st);
Write('Длительность ремонта > '); ReadLn(Repair);

p := Pos('.', st);
Day := GetInteger( Copy(st, 1, Pred(p)) );
Month := GetInteger( Copy(st, Succ(p), Length(st)-p) );

For i := 1 To Pred(Month) Do
Inc(DaysBefore, DayInMonth[i]);
Inc(DaysBefore, Day);

Inc(DaysBefore, Repair);
i := 1;
While DaysBefore > DayInMonth[i] Do
Begin
Dec(DaysBefore, DayInMonth[i]); Inc(i)
End;
WriteLn('Ремонт закончится: ', DaysBefore, '.', i);
end.

by Volvo

Еще один вариант
program Lab8_02_2;
uses crt,dos;
var
q:char;
data:record
day,year,months:word;
end;
j:integer;
week:word;
m:integer;
g:word;

const
month:array[1..12] of string[7] =
('января','февраля','марта','апреля','мая','июня','июля',
'августа','сентябя','октября','ноября','декабря');
a:array[1..12] of integer =
(31,29,31,30,31,30,31,31,30,31,30,31);

begin
repeat
clrscr;
getdate(data.year,data.months,data.day,week);
g:=data.months;
writeln('Сегодняшняя дата: ',data.day,' ',month[g]);
writeln('введите число m через которое вы хотите узнать дату:');
read(m);
j:=m;
while j<>0 do begin
if j>a[data.months]-data.day then begin
j:=j-(a[data.months]-data.day);
inc(data.months);
data.day:=0;
end

else begin
data.day:=data.day+j; break;
end;
end;

g:=data.months;
writeln('Дата дня и месяц: ',data.day,' ',month[g] );
write('Вычислить еще ?(Y/N)');
q:=ReadKey;
until not (q in ['Y','y']);
end.

by Amro


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


2) Задача про старокитайский календарь
В старокитайском календаре был принят 60-летний цикл состоящий из 5 двенадцатилетних подциклов. Подциклы обозначались названиями цвета:
• Зеленый
• Красный
• Желтый
• Белый
• Черный
Внутри каждого подцикла годы получили название животных:
• Крыса
• Корова
• Тигр
• Заяц
• Дракон
• Змея
• Лошадь
• Овца
• Обезьяна
• Курица
• Собака
• Свинья
(К примеру 1984–год зеленой крысы - был началом очередного цикла). Написать программу, которая вводит номер некоторого года нашей эры и печатает его название по старояпонскому календарю.

var

y : array [0..11] of string =

(
'Rat',
'Cow',
'Tiger',
'Rabbit',
'Dragon',
'Snake',
'Horse',
'Sheep',
'Monkey',
'Chicken',
'Dog',
'Pig'
);

d : array[0..4] of string =

(
'Green',
'Red',
'Yellow',
'White',
'Black'
);


year:Integer;

begin

writeln('Input year'); readln(year);

year := (year mod 60)-4;

If year<0 then year := year+60;

writeln(d[year div 12],' ',y[year mod 12]);

end.

by Idea


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Модуль для работы с календарем

{
Calendar.pas

Набор функций для работы с датами и вычислений по календарю.
Автор: Виктор Осташев
Fido: 2:5020/1194
E-mail: v_ostashev@chat.ru
WWW: _http://ostashev.newmail.ru
}

function datein(low, high, dt : tdate) : boolean;
{ Проверяет нахождение даты в промежутке между low и high }

procedure stringtodate(st : string; var dt : tdate);
{ Преобразует строку в дату }

procedure datetostring(dt : tdate; var st : string);
{ Преобразует дату в строку }

function compdate(d1, d2 : tdate) : integer;
{
Сравнивает две даты. Возвращает:
0, если даты равны;
-1, если первая дата меньше второй;
1, если вторая дата меньше первой
}

function numofday(dat : tdate; style : tstyle) : longint;
{ Вычисляет условный номер дня для даты dat
с учетом нового стиля при style=true }

function dayofweek(dat : tdate; style : tstyle) : byte;
{ Вычисляет день недели для даты dat с
учетом нового стиля при style=true }

function numinyear(dat : tdate; style : tstyle) : word;
{ Вычисляет номер дня от начала года с учетом стиля }

function lenofmonth(month: byte; year: word; style: tstyle): byte;
{ Вычисляет длину месяца с учетом стиля }

procedure numtodate(num: longint; style: tstyle; var dat: tdate);
{ Вычисляет дату по данному номеру дня }

function isleap(year : integer):boolean;
{ Является ли год високосным }


Прикрепленные файлы
Прикрепленный файл  calenfun.zip ( 2.15 килобайт ) Кол-во скачиваний: 682


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


программа исправлена, готовится еще более компактная версия, и фатально короткая версия))
Как определить количество дней прошедших между двумя датами ? Вот такой мой вариант, предлагайте свои, о найденных ошибках сообщайте сюда: Собираем Ошибки!

const
day_in_month: array [boolean, 1 .. 12] of word = (
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
);

day_in_year: array [boolean] of word = (365, 366);

function is_leap(const year: word): boolean;
begin
is_leap := (year mod 4 = 0) and not((year mod 100 = 0) and (year mod 400 <> 0));
end;

function to_next_month(var year, month, day: word): word;
var
days: word;
begin
days := day_in_month[is_leap(year), month] - day + 1;

if month < 12 then inc(month) else begin
month := 1;
inc(year);
end;

day := 1;

to_next_month := days;
end;

function days_between(const start_year, start_month, start_day,
final_year, final_month, final_day: word): word;
var
year, month, day, days: word;
begin
days := 0;

if (start_year = final_year) and (start_month = final_month) then
days := final_day - start_day else begin
year := start_year;
month := start_month;
day := start_day;

while (year < final_year) or (month < final_month) do inc(days, to_next_month(year, month, day));

days := days + final_day - 1;
end;

days_between := days;
end;

var
start_year, start_month, start_day: word;
final_year, final_month, final_day: word;
begin


start_year := 1986;
start_month := 12;
start_day := 19;

final_year := 2088;
final_month := 7;
final_day := 15;

writeln(days_between(start_year, start_month, start_day,
final_year, final_month, final_day));
end.


Сообщение отредактировано: klem4 -


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 19.09.2017 20:41
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"