Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача в паскале.определить входит ли в треугольник с заданными координатами начало координат.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
serg
Собственно в теме написано,помогите,желательно без функций.
sheka
Сумма площадей 3х треугольников, основы которых стороны заданого, а вершина - т(0;0) должна быть равной площади заданого. Почему без функций? с ними намного короче! Один раз вбили Герона и Пифагора - и все.
Unconnected
Наверное, ты хотел написать > Задача в паскале.определить входит ли в треугольник с заданными координатами В начало координат.?

И я не совсем понял, а это как? Типа лежит ли одна его вершина в координате 0,0?
sheka
Цитата(Unconnected @ 23.11.2009 21:19) *
И я не совсем понял, а это как?

Нажмите для просмотра прикрепленного файла
serg
ну без функций потомучто препод потом спросит как я это делал)а я не знаю,картинку правильно нарисовал,можешь прогу написать?а то я с паскалем не дружу(
sheka
Ну до функций ты ведь знаешь? Вот и пиши. Если потом вдруг помирюсь с паскалем - напишу.
serg
ну надеюс твой способ с площадями верный)постораюсь решить,спасибо.Но если сам сделаешь её напиши пожалуйста)
sheka
Сделаю сразу же после того как твой вариант увижу. lol.gif
Unconnected
Вот оно, воплощение извращения))

var koor:array[1..6] of integer;
i,s:byte;

function chet(x,y:integer):byte;
begin
if (x>0) and (y>0) then chet:=1;
if (x>0) and (y<0) then chet:=2;
if (x<0) and (y<0) then chet:=3;
if (x<0) and (y>0) then chet:=4;
end;

begin
writeln('Vvedite koordinati vershini #1');
readln(koor[1],koor[2]);
writeln('Vvedite koordinati vershini #2');
readln(koor[3],koor[4]);
writeln('Vvedite koordinati vershini #3');
readln(koor[5],koor[6]);
if (chet(koor[1],koor[2])<>chet(koor[3],koor[4])) and
(chet(koor[3],koor[4])<>chet(koor[5],koor[6])) and
(chet(koor[1],koor[2])<>chet(koor[5],koor[6])) then writeln('YES, of course')
else writeln('NO, it isn"t');
readln;
end.


Без функций не получилось:)
serg
ух...спасибо.попробую,работает?)))
Unconnected
Ну да, тут за неработающее ругают) Только по логике моей программы если сторона лежит на оси координат, то начало координат не лежит в треугольнике..
sheka
Цитата(Unconnected @ 23.11.2009 21:50) *

Вот оно, воплощение извращения))
no1.gif А я не согласен! lol.gif Нажмите для просмотра прикрепленного файла
При таком варианте там намного больше условий должно быть!
Unconnected
Блиииин я забыл, сейчас переделаю..
sheka
Цитата(Unconnected @ 23.11.2009 21:53) *

Ну да, тут за неработающее ругают)
Исправляй пока никто не видел! rolleyes.gif
Unconnected
Извращение, v.1.02

var koor:array[1..6] of integer;
i,s:byte;

function chet(x,y:integer):byte;
begin
if (x>0) and (y>0) then chet:=1;
if (x>0) and (y<0) then chet:=2;
if (x<0) and (y<0) then chet:=3;
if (x<0) and (y>0) then chet:=4;
end;

begin
writeln('Vvedite koordinati vershini #',1);
readln(koor[1],koor[2]);
writeln('Vvedite koordinati vershini #',2);
readln(koor[3],koor[4]);
writeln('Vvedite koordinati vershini #',3);
readln(koor[5],koor[6]);
if (chet(koor[1],koor[2])<>chet(koor[3],koor[4])) and
(chet(koor[3],koor[4])<>chet(koor[5],koor[6])) and
(chet(koor[1],koor[2])<>chet(koor[5],koor[6])) then writeln('YES, of course')
else
if (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=5)
or (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=7)
or (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=8)
or (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=10)
then writeln('YES, of course')
else writeln('NO,it isn"t...');
readln;
end.


Только у меня четверти расположены не как в тригонометрическом круге, а традиционно, по часовой:)
sheka
or (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=7)
Unconnected
lol.gif всё, сдаюсь, Героны рулят))
serg
ну напишите хотябы через функцию но рабочуюю блин!))
sheka
Цитата(Unconnected @ 23.11.2009 22:30) *

lol.gif всё, сдаюсь, Героны рулят))
Пифагоров забыл! mad.gif


Добавлено через 1 мин.
Цитата
ну напишите хотябы через функцию но рабочуюю блин!))

ну напишите хотябы не через функцию но самостоятельно блин!))
Unconnected
FATALITY!

var koor:array[1..6] of integer;
i,s:byte;

function chet(x,y:integer):byte;
begin
if (x>0) and (y>0) then chet:=1;
if (x>0) and (y<0) then chet:=2;
if (x<0) and (y<0) then chet:=3;
if (x<0) and (y>0) then chet:=4;
end;

begin
writeln('Vvedite koordinati vershini #',1);
readln(koor[1],koor[2]);
writeln('Vvedite koordinati vershini #',2);
readln(koor[3],koor[4]);
writeln('Vvedite koordinati vershini #',3);
readln(koor[5],koor[6]);
if (chet(koor[1],koor[2])<>chet(koor[3],koor[4])) and
(chet(koor[3],koor[4])<>chet(koor[5],koor[6])) and
(chet(koor[1],koor[2])<>chet(koor[5],koor[6])) then writeln('YES, of course')
else
if (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=5)
or ((chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=7)
and (chet(koor[1],koor[2])=1) or (chet(koor[3],koor[4])=1))
or (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=8)
or ((chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=10)
and (chet(koor[1],koor[2])=4) or (chet(koor[3],koor[4])=4))
then writeln('YES, of course')
else writeln('NO,it isn"t...');
readln;
end.
serg
Цитата(sheka @ 23.11.2009 23:33) *

Пифагоров забыл! mad.gif
Добавлено через 1 мин.

ну напишите хотябы не через функцию но самостоятельно блин!))

да если бы я сам мог то не писал бы сюда
sheka
Цитата(Unconnected @ 23.11.2009 22:58) *

FATALITY!
А что это значит FATALITY! ?


Цитата
if (chet(koor[1],koor[2])+chet(koor[3],koor[4])+chet(koor[5],koor[6])=5)
or
Нажмите для просмотра прикрепленного файла
Lapp
Что-то вы, мне кажется, тут перемудрили..
Простые решения уже не в моде? smile.gif
И тут абсолютно не нужны никакие функции.
const
n=3; {треугольник}
r=9; {диапазон чисел}

var
t: array [1..n] of record
x,y: double;
end;
i: integer;
Inside: boolean;
u,v: double;

begin
Randomize;
for i:=1 to n do with t[i] do begin
x:=Random®*2-r;
y:=Random®*2-r;
WriteLn('x',i,'=',x:2:0,' y',i,'=',y:2:0);
end;
Inside:=true;
for i:=1 to n do begin
v:=t[i].x*t[i mod n+1].y-t[i].y*t[i mod n+1].x;
if i>1 then Inside:=Inside and (u*v>1e-15);
u:=v
end;
WriteLn(Inside)
end.
serg
Цитата(Lapp @ 24.11.2009 4:33) *

Что-то вы, мне кажется, тут перемудрили..
Простые решения уже не в моде? smile.gif
И тут абсолютно не нужны никакие функции.
const
n=3; {треугольник}
r=9; {диапазон чисел}

var
t: array [1..n] of record
x,y: double;
end;
i: integer;
Inside: boolean;
u,v: double;

begin
Randomize;
for i:=1 to n do with t[i] do begin
x:=Random®*2-r;
y:=Random®*2-r;
WriteLn('x',i,'=',x:2:0,' y',i,'=',y:2:0);
end;
Inside:=true;
for i:=1 to n do begin
v:=t[i].x*t[i mod n+1].y-t[i].y*t[i mod n+1].x;
if i>1 then Inside:=Inside and (u*v>1e-15);
u:=v
end;
WriteLn(Inside)
end.



Arifmethic overflow???
Lapp
Цитата(serg @ 24.11.2009 10:01) *
Arifmethic overflow???

где?



Добавлено через 5 мин.
Попробуй замеить тип double на real
а при проверке сравнивай не с 1e-15, а 1e-7
volvo
Цитата
где?
Здесь:
Цитата
  for i:=1 to n do with t[i] do begin
x:=Random®*2-r; { <--- }
y:=Random®*2-r; { <--- }
WriteLn('x',i,'=',x:2:0,' y',i,'=',y:2:0);
end;
как минимум. Random вернет значение типа Word, и как только 2*Random( r ) будет меньше, чем R - попытка сделать Word отрицательным приведет к RTE 215 (все вышесказанное относится к Турбо Паскаль 7). Патч:
  for i:=1 to n do with t[i] do begin
x:=Integer(Random®*2)-r; { <--- }
y:=Integer(Random®*2)-r; { <--- }
WriteLn('x',i,'=',x:2:0,' y',i,'=',y:2:0);
end;
, теперь ошибки не будет. Integer вполне способен принимать отрицательные значения.
Lapp
Цитата(volvo @ 24.11.2009 12:19) *
Random вернет значение типа Word,
Спасибо, volvo. Постоянно об этом забываю. FPC расслабляет..
+1
serg
теперь чтото не запускает %) что делать?((
volvo
Цитата
еперь чтото не запускает %) что делать?((
Что значит "не запускает"? Может, отрабатывает и ты не успевашь результаты посмотреть? Нажми на Alt+F5 тогда, увидишь. Или перед end. добавь ReadLn - программа подождет, пока ты нажмешь на Enter и только потом закроется.
serg
Цитата(volvo @ 24.11.2009 13:26) *

Что значит "не запускает"? Может, отрабатывает и ты не успевашь результаты посмотреть? Нажми на Alt+F5 тогда, увидишь. Или перед end. добавь ReadLn - программа подождет, пока ты нажмешь на Enter и только потом закроется.

я нажимаю RUN а она просто тупо не начинается
serg
все щикарно,спасибо огромное вам
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.