Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Расчет биоритмов
Автор: Farfalla 15.12.2007 23:33
Составить программу отражения биоритмов человека на заданный интервал времени. Известно, что физическое, эмоциональное и умственное состояния изменяются со дня рождения циклически с периодом 23, 28, 33 дня соответственно. Состояние для Д-го дня со дня рождения определятся по формуле: y=sin(x1),
где x1=(Д/Р - [Д/Р])*2П при P=23,28,33.
[Д/Р] - целая часть от деления
C биоритмами ранее сталкивать не приходилось. Пыталась разобраться, но всё тщетно.
Автор: compiler 16.12.2007 0:04
у Фаранова была такая задача(решение из его примеров)
Прикрепленные файлы
BIORITM.PAS ( 7.1 килобайт )
Кол-во скачиваний: 384
Автор: Farfalla 17.12.2007 21:02
Дальше совсем не получается. Помогите с графиками, пожалуйста.
program bio ;
uses crt;
const
Size_of_Month: array [1..12] of byte = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var
d0, d, dd1, dd2, { День рождения, день текущий. }
m0, m, dm1, dm2, { Depeche Mode.. ;) }
y0, y, dy1, dy2,
days, dmin, dmax: integer;
tstr: string[1];
Label L1 ;
procedure SplashScreen;
var
tmp: string[1];
begin
textbackground (White) ;
textColor (Red);
ClrScr;
gotoxy (20,1) ;
Writeln('Вашему вниманию представляется программа, ');
gotoxy (18,2) ;
Writeln('которая рассчитывает биоритмы человека' );
gotoxy (20,3) ;
Writeln('на заданный интервал времени');
gotoxy (40,12) ;
writeln('Программу составила студентка');
gotoxy (40,13) ;
writeln('');
gotoxy (49,14) ;
writeln('');
gotoxy (40,15) ;
writeln('') ;
gotoxy (20,24);
writeln('Нажмите любую клавишу для продолжения');
read(tmp);
ClrScr;
end;
procedure iDates(var d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2: integer);
var
isCorr: boolean;
procedure rDate(wel: string; var d, m, y: integer);
const
ymin = 1800;
ymax = 2200;
begin
repeat
Write('Введите ' + wel + ' в формате ДД ММ ГГГГ: ');
ReadLn(d, m, y);
isCorr := (y >= ymin) and (Y <= ymax) and (m >= 1)
and (m <= 12) and (d > 0);
if isCorr then
if (m = 2) and (d = 29) and (y mod 4 = 0) then
{foo bar, ибо этого дня не существует..}
else
isCorr := d <= Size_of_Month[m];
if not isCorr then WriteLn('Ошибка в дате');
until isCorr;
end;
begin
repeat
rDate('дату рождения', d0, m0, y0);
rDate('текущую дату', d,m,y);
{test for corr. input}
isCorr := y > y0;
if not isCorr and (y = y0) then
begin
isCorr := m > m0;
if not isCorr and (y = y0) then
begin
isCorr := m > m0;
if not isCorr and (m = m0) then
isCorr := d >= d0;
end;
end;
until isCorr;
rDate('начальную дату диапазона поиска', dd1, dm1, dy1);
rDate('конечную дату диапазона поиска', dd2, dm2, dy2);
end;
procedure getDays (d0, m0, y0, d, m, y: integer; var days: integer);
Procedure mLoop;
var
mm: integer;
begin
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;
procedure ymLoop;
var
mm, yy: integer;
begin
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;
begin
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 mLoop else ymLoop;
end;
end;
procedure parseGraph(d0, m0, y0, dmin, dmax: integer);
const
pPhisics = 2*3.1416/23.6884;
pEmo = 2*3.1416/28.4261;
pIntellect = 2*3.1416/33.1638;
var
dall, dcurr, i: integer;
rP, rE, rI: real;
begin
dall := dmax - dmin;
if dall < 0 then begin
WriteLn('Ошибка: Начальная точка периода привышает конечную.');
end;
for i := 0 to dall do
begin
dcurr := dmin + dall;
rP := sin(dcurr * pPhisics);
rE := sin(dcurr * pEmo);
rI := sin(dcurr * pIntellect);
write(' ['); write(rP); write(' | '); write(rE); write(' | ');
write(rI); write('] ');
end
end;
BEGIN
{ main proc. }
SplashScreen;
iDates(d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2);
getDays(d0, m0, y0, d, m, y, days);
getDays(d0, m0, y0, dd1, dm1, dy1, dmin);
getDays(d0, m0, y0, dd2, dm2, dy2, dmax);
parseGraph(d0, m0, y0, dmin, dmax);
read(tstr);
END.
Автор: Lapp 18.12.2007 12:25
Цитата(Farfalla @ 17.12.2007 17:02) 
Помогите с графиками, пожалуйста.
Правильно я понял, что ты хочешь графики рисовать в текстовой моде? Типа как когда-то эти биоритмы распечатывали на АЦПУ?
Или ты просто хочешь распечатывать значения синусов? Если второе, то это просто - нужно только поставить WriteLn в конце цикла в процедуре ParseGraph.
Если же первое, то придется поизвращаться с печатью пробелов.. Если нужно - я помогу.
Автор: Гость 20.12.2007 3:06
Нужен именно первый вариант. Было бы здорово, если бы ты помог
Автор: Farfalla 20.12.2007 6:26
Цитата(Lapp @ 18.12.2007 8:25)
Правильно я понял, что ты хочешь графики рисовать в текстовой моде? Типа как когда-то эти биоритмы распечатывали на АЦПУ?
Если же первое, то придется поизвращаться с печатью пробелов.. Если нужно - я помогу.
Очень нужно))
Автор: Lapp 20.12.2007 10:22
Все изменения касаются только процедуры ParseGraph, которую я полностью привожу
procedure parseGraph(d0, m0, y0, dmin, dmax: integer);
const
pPhisics = 2*3.1416/23.6884;
pEmo = 2*3.1416/28.4261;
pIntellect = 2*3.1416/33.1638;
var
dall, dcurr, i, j, gw: integer;
rP, rE, rI: real;
s: string;
begin
dall := dmax - dmin;
if dall < 0 then WriteLn('Ошибка: Начальная точка привышает конечную.');
gw:=WindMax and $FF -12;
for i := 0 to dall do begin
dcurr := dmin + i;
rP := sin(dcurr * pPhisics);
rE := sin(dcurr * pEmo);
rI := sin(dcurr * pIntellect);
{write(' [');
write(rP);
write(' | ');
write(rE);
write(' | ');
write(rI);
write('] ');
WriteLn;}
s:='';
for j:=1 to gw do s:=s+' ';
s[Trunc((rP+1)/2*gw+1)]:='p';
s[Trunc((rE+1)/2*gw+1)]:='e';
s[Trunc((rI+1)/2*gw+1)]:='i';
WriteLn(dd1:2,dm1:3,dy1:5,' :',s,':');
Inc(dd1);
if dd1>Size_of_Month[dm1] then begin
dd1:=1;
Inc(dm1);
if dm1>12 then begin
dm1:=1;
Inc(dy1)
end
end;
end
end;
А вот как примерно выглядит график (минимум слева, максимум справа):
15 11 2007 : p i e :Это то, что ты хотела?
16 11 2007 : p i e :
17 11 2007 : p i e :
18 11 2007 :p i e :
19 11 2007 :p i e :
20 11 2007 :i p e :
21 11 2007 :i p e :
22 11 2007 :i p e :
23 11 2007 : i e p :
24 11 2007 : ie p :
25 11 2007 : e i p :
26 11 2007 :e i p :
27 11 2007 :e i p :
28 11 2007 : e i p :
29 11 2007 : e i p :
30 11 2007 : e i p:
1 12 2007 : e i p:
2 12 2007 : e i p :
3 12 2007 : e i p :
4 12 2007 : e p i :
5 12 2007 : e p i :
6 12 2007 : p e i :
7 12 2007 : p e i:
8 12 2007 : p e i:
9 12 2007 : p e i :
10 12 2007 : p i e:
11 12 2007 : p i e:
12 12 2007 :p i e:
13 12 2007 :p i e :
14 12 2007 : p i e :
15 12 2007 : p i e :
16 12 2007 : p i e :
17 12 2007 : p i e :
18 12 2007 : i p e :
19 12 2007 : i e p :
20 12 2007 : i e p :
21 12 2007 : i e p :
22 12 2007 : i e p :
23 12 2007 :i e p :
24 12 2007 :ie p:
25 12 2007 :i p :
26 12 2007 :e i p :
27 12 2007 : e i p :
28 12 2007 : e i p :
29 12 2007 : e i p :
30 12 2007 : e i p :
31 12 2007 : epi :
1 1 2008 : p i :
Разберись со всем, чтоб не было неожиданностей при сдаче
Добавлено через 3 мин.
Только я так и не понял - и зачем ты спрашиваешь текущую дату?..
Автор: Farfalla 20.12.2007 19:00
Цитата
Это то, что ты хотела?
Разберись со всем, чтоб не было неожиданностей при сдаче
Разберись со всем, чтоб не было неожиданностей при сдаче
Всё работает, большое спасибо, но сегодня мне сказали, что график по идее должен представлять собой три синусоиды в одной координатной плоскости. Возможно ли такое вообще? Трудно сообразить, как это сделать.
Цитата
Только я так и не понял - и зачем ты спрашиваешь текущую дату?..
Текущая дата не нужна, вводила в самом начале, еще не разобравшись. Надо стереть)
Автор: Lapp 21.12.2007 2:40
Цитата(Farfalla @ 20.12.2007 15:00)
график по идее должен представлять собой три синусоиды в одной координатной плоскости.
А тут и есть три синусоиды в одной координатной плоскости... Я не понял, что ты хотела сказать. Нарисуй карандашиком.
Автор: Farfalla 22.12.2007 5:04
Цитата(Lapp @ 20.12.2007 22:40)
А тут и есть три синусоиды в одной координатной плоскости... Я не понял, что ты хотела сказать. Нарисуй карандашиком.
График должен быть не в виде текста..(
Автор: Lapp 22.12.2007 8:56
Цитата(Farfalla @ 22.12.2007 1:04)
График должен быть не в виде текста..(
Ну, дружочек... Я спросил тебя - тебе нужен график в текстовой моде? Ты сказала - да..
Зачем, спрашивается, я тратил время?...
Автор: Farfalla 22.12.2007 23:14
Цитата(Lapp @ 22.12.2007 4:56)
Ну, дружочек... Я спросил тебя - тебе нужен график в текстовой моде? Ты сказала - да..
Зачем, спрашивается, я тратил время?...
Если бы сразу сказали, что в текстовой не принимают
Извините
Автор: Farfalla 24.12.2007 4:48
А с блок-схемой тут кстати как?
Хотя бы этот вариант пока покажу. Деваться-то некуда
Автор: Lapp 24.12.2007 18:32
Цитата(Farfalla @ 24.12.2007 0:48)
А с блок-схемой тут кстати как?
Или речь идет о б-с вывода графика?
Кстати, если тебе нужен обычный график в графической моде- какие сложности? Поищи пример работы с графикой.. Скажем, в FAQ есть прога, строящая любые графики.
Автор: Farfalla 25.12.2007 4:09
Цитата(Lapp @ 24.12.2007 14:32)
С блок-схемой чего? программы? Так ты сама ее делала - сделай и блок-схему..
Или речь идет о б-с вывода графика?
Кстати, если тебе нужен обычный график в графической моде- какие сложности? Поищи пример работы с графикой.. Скажем, в FAQ есть прога, строящая любые графики.
Я сделала, но у меня там в конце затруднения появились. Сдала, как смогла, но ее не приняли.
Для меня это сложно.
Сегодня принесла работу с тем, что вы мне помогли, придрались к тому, что нет второй оси. первая - это даты, а второй нет.