(1 курс ФИИТ) ОП - лекц - 2015 (устарело)

[Romanovsky]

   К сегодняшней лекции: программа, которая делает n-й бит числа равным 1
 begin
  var a:=ReadInteger('Введите а');
  var n:=ReadInteger('Введите номер бита, который должен быть заменён на 1');
  a:= a or (1 shl (n-1);
 Writeln(a);
 end.

[Haku]

Вариант решения домашней задачи о проверки нахождения точки внутри треугольника:
(Можно ли его упростить?)

function Side(x1, y1, x2, y2: integer): real;
begin
result := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
end;

function Area(a, b, c: real): real;
begin
var p: real;
p := (a + b + c) / 2;
result := sqrt(p * (p - a) * (p - b) * (p - c));
end;

begin
writeln('Введите координаты точек A,B,C,M:');
var xa, ya, xb, yb, xc, yc, xm, ym: integer;
readln(xa, ya, xb, yb, xc, yc, xm, ym);
var ac := Side(xa, ya, xc, yc); //Находим стороны треугольников
var bc := Side(xb, yb, xc, yc);
var ab := Side(xa, ya, xb, yb);
var am := Side(xa, ya, xm, ym);
var bm := Side(xb, yb, xm, ym);
var cm := Side(xc, yc, xm, ym);
Write('Точка М ');
if (Area(am, bm, ab) + Area(bm, bc, cm) + Area(ac, cm, am)) <> Area(ab, ac, bc)
then Write('не ');
Write('лежит внутри треугольника ');
end.

[Ilya]

а если точка внутри теугольника?

[Haku]

Тогда ветка if не выполняется,и ответ выводится без "не", т.е. "Точка М лежит внутри треугольника".
Или ты спрашиваешь о чем-то другом?

[Ilya]

но он не всегда верно работает, например я ввел точку, которая лежит на стороне треугольника и алгоритм написал, что она не лежит внутри

[Haku]

Я думаю: может быть это из-за того,что площади получаются вещественные? А ты как считаешь?

[Ilya]

я тоже думаю, что из-за этого, кстати я ввел точку внутри теугольника(не на стороне) и он все равно сказал что она не лежит внутри

[Haku]

Тоже так получилось в этот раз. Но как его изменить? Если округлить, то площади тоже могут получиться разными.

[Ilya]

задача, которая определяет, является ли четырех-угольник соответствующим условию задачи.
(невыпуклый тоже считается требуемым)

//в данном решении выбирается прямые , на которых лежат 1 и 3 точки,2 и 4 , вычиcляется их k и b
//затем по уравнению расстояния от точки до прямой вычисляется, 
//с какой стороны прямой лежат 2 другие точки, и на основании этого дается ответ
begin
  var x1, x2, x3, x4, y1, y2, y3, y4: real;
  var  k, k2, b, b2: real;
  var t1: boolean = false;
  var t2: boolean = false;  
  writeln('введите координаты точек 4-угольника');
  readln(x1, y1, x2, y2, x3, y3, x4, y4);
  
  //1 сторона(AC) и проверка точек B и D
  if x3 <> x1 then
  begin
    k := (y3 - y1) / (x3 - x1);
    b := y1 - k * x1;
    t1 := (sign( (-1)*k*x2 + y2 - b ) = (-1) * sign( (-1)*k*x4 + y4 - b ) );   
  end
  else 
    t1 := ((x2 > x1) = (x4 < x1));
    
  //2 сторона (BD) и проверка точек A и C
  if x2 <> x4 then
  begin
    k2 := (y4 - y2) / (x4 - x2);
    b2 := y2 - k * x2;
    t2 := (sign( (-1)*k2*x1+y1-b2) = (-1) * sign( (-1)*k2*x3 + y3 - b2) );
  end    
  else 
    t2 := ((x3 > x2) = (x1 < x2));
  
  if t1 or t2 then
    writeln('это 4-угольник')
  else
    writeln('это не 4-угольник');    
end.

[Haku]

Вот мое решение второй задачи. Делала через косинусы углов. Но решение не всегда получается правильным. В чем моя ошибка?

function Side(x1, y1, x2, y2: integer): real;
begin
result := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
end;

function Cosin(x1, x2, y1, y2, x3, y3: integer; a, b: real): real;
begin
result := ((x2 - x1) * (x3 - x1) + (y2 - y1) * (y3 - y1)) / (a * b);
end;

begin
writeln('Введите координаты точек A,B,C,D:');
var xa, ya, xb, yb, xc, yc, xd, yd: integer;
readln(xa, ya, xb, yb, xc, yc, xd, yd);
var ad := Side(xa, ya, xd, yd); //Находим стороны фигуры
var bc := Side(xb, yb, xc, yc);
var ab := Side(xa, ya, xb, yb);
var cd := Side(xc, yc, xd, yd);
var a := Cosin(xa, ya, xb, yb, xd, yd, ad, ab); //находим косинусы углов
var b := Cosin(xb, yb, xc, yc, xa, ya, bc, ab);
var c := Cosin(xc, yc, xb, yb, xd, yd, cd, bc);
var d := Cosin(xd, yd, xc, yc, xa, ya, ad, cd);
if (a > 0) and (b > 0) and (c > 0) and (d > 0) then
writeln('Не является четырехугольником')
else
if (a = 0) and (b = 0) and (c = 0) and (d = 0) then
writeln('Является четырехугольником')
else
if a * b * c * d = 0 then
writeln('Не является четырехугольником')
else
write('Является четырехугольником');
end.

[Ilya]

а невыпуклый учитывается?

[Haku]

Я пыталась сделать так,чтобы учитывался.

[Haku]

И он учитывается

[Ilya]

если у тебя хотя бы 1 угол прямой(cos=0) ,например в прямой трапеции то в последнем if выполняется первая ветка. к тому же можно построить не четырех угольник с тупым или 2 тупыми углами, и тогда первое условие не выполнится

[Haku]

О,спасибо)

[John_Hannibal_Smit]

// анал геом посвящается следущая программа, т.к. идея с площадами была нещадно украдена
// за два часа, как я до не додумался, то вот следующий алгоритм, но пока не полный, чуть позже, мб, доделаю

function find_x_y (xm, ym, x, y, x1, y1, x2, y2, ixmin, iymin, ixmax, iymax: real): boolean; //с начала нахождение точки пересечения с двумя прямыми (основания (пусть верш 1, 2) и прям( m и 3 верш))
begin// потом смотрит находится ли точка в треугольнике(соответствует ixmin, iymin. ixmax iymax)
var k,k1, xfunc, yfunc:real;
k:=(y1-y)/(x1-x);
k1:=(ym-y2)/(xm-x2);

xfunc:=(k*x-k1*x+y2-y)/(k-k1);
yfunc:=y2+k1*(xfunc-x2);

if (xfunc>=ixmin) and (xfunc<=ixmax) and (yfunc>=iymin) and (yfunc<=iymax) then find_x_y:= True else find_x_y:=False;
end;

function find_x_y1 (xm, ym, x, y, x1, y1, x2, y2, ixmin, iymin, ixmax, iymax: real): boolean; //с начала нахождение точки пересечения с двумя прямыми (основания (пусть верш 1, 2) и прям( m и 3 верш))
begin// потом смотрит находится ли точка в треугольнике(соответствует ixmin, iymin. ixmax iymax)
var k,k1, xfunc, yfunc:real;
k:=(y2-y)/(x2-x);
k1:=(ym-y1)/(xm-x1);

xfunc:=(k1*x1-k*x+y-y1)/(k1-k);
yfunc:=y1+k1*(xfunc-x1);

if (xfunc>=ixmin) and (xfunc<=ixmax) and (yfunc>=iymin) and (yfunc<=iymax) then find_x_y1:= True else find_x_y1:=False;
end;

var ix, iy, x, y: array of real;
begin
SetLength(x, 3);
SetLength(iy, 3);
SetLength(y, 3);
SetLength(ix, 3);
writeln('Введите координаты точек треугольника, такие, что их ординаты не равны и абсциссы тоже');
for var i:=0 to 2 do begin
readln(x[i], y[i]);
ix[i]:=x[i];
iy[i]:=y[i];
end;

var a:=sqrt(sqr(x[0]-x[1])+sqr(y[0]-y[1]));
var b:=sqrt(sqr(x[0]-x[2])+sqr(y[0]-y[2]));
var c:=sqrt(sqr(x[2]-x[1])+sqr(y[2]-y[1]));
var bo:=(a+b>c) and (a+c>b) and (c+b>a);

if (x[0]<>x[1]) and (x[2]<>x[1]) and (x[0]<>x[2]) and (y[0]<>y[1]) and (y[2]<>y[1]) and (y[0]<>y[2]) then
if bo then
begin
sort(iy); sort(ix);
var xm:=readreal('Введите абсциссу точки M, такую, чтобы xm<>x1,x2,x3');
var ym:=readreal('Введите ординату точки M, такую, чтобы ym<>y1,y2,y3');

   if (xm<>x[1]) and (xm<>x[2]) and (xm<>x[0]) and  (ym<>y[1]) and (ym<>y[2]) and (ym<>y[0]) then
     if (xm<ix[0]) or (xm>x[2]) or (ym<y[0]) or (ym>y[2]) then writeln('Точка вне треугольника') else
     begin  writeln('Теперь приступим к анал геом!');
        if find_x_y1(xm, ym, x[0], y[0], x[1], y[1], x[2], y[2], ix[0], iy[0], ix[2], iy[2]) and find_x_y(xm, ym, x[0], y[0], x[1], y[1], x[2], y[2], ix[0], iy[0], ix[2], iy[2]) then


        writeln ('Точка лежит в треугольнике! или на границе, кто  знает?!')
        else writeln('ДАже анал геом не помогла этой точке лежать в треугольнике или на границе, это фейл');

     end
   else writeln('Вы печалити меня')
end
else writeln('Вы не прошли защиту от дураков..')

else writeln('Уныние - страшный грех, лучше встанте из-за компьютера и пробежитесь кружок вокруг вашего микрорайона/города');

end.

Есть небольшой фейл( насчет функций ), они обе соответсвуют друг другу, просто там идут некоторые вычисления, и очень сильно лень копаться, где должне быть какой параметр, а вообще можно обойтись одной, но трудно

[Ilya]

моя программа на определение того, лежит ли точка внутри треугольника, на его стороне, или вне его

программа основана на формуле нахождения расстояния от точки до прямой. Сначала определяется ,
с какой стороны прямых, на которой лежат стороны треугольника лежит наша точка.
для этого мы берем точку внутри треугольника,
которой является ее центр, и сравниваем, лежат ли точка M и средняя точка по одну и 
ту же сторону от прямых. Если это условие выполняется для всех сторон, то точка внутри.
Так как если точка лежит на стороне, то при подстановке ее координат в уравнение прямой
должен получаться 0.

function Side(k, b, x, y: real): real;
begin
  result := (-1) * k * x + y - b;
end;

var
  x1, x2, x3, y1, y2, y3, xm, ym: real;
  k1, k2, k3, b1, b2, b3, xsr, ysr: real;
  equ1, equ2, equ3, Nast: boolean;

begin
  writeln('введите координаты точек треугольника');
  readln(x1, y1, x2, y2, x3, y3);
  writeln('введите координаты точки m');
  readln(xm, ym);
  equ1 := false;
  equ2 := false;
  equ3 := false;
  Nast := false;
  
  xsr := (x1 + x2 + x3) / 3;
  ysr := (y1 + y2 + y3) / 3;
  
  if x2 <> x1 then 
  begin
    k1 := (y2 - y1) / (x2 - x1);
    b1 := y1 - k1 * x1;
    equ1 := (Sign(Side(k1, b1, xm, ym)) = Sign(Side(k1, b1, xsr, ysr)) );
  end
  else
  if (xm = x1) and (ym <= max(y2, y1)) and (ym >= min(y2, y1))then //если прямая вертикальная
    Nast := true
  else
    equ1 := Sign(xm - xsr) = Sign(x1 - xsr);
  
  if x2 <> x3 then 
  begin
    k2 := (y3 - y2) / (x3 - x2);
    b2 := y2 - k2 * x2;
    equ2 := (Sign(Side(k2, b2, xm, ym)) = Sign(Side(k2, b2, xsr, ysr)) );
  end
  else
  if (xm = x2) and (ym <= max(y3, y2)) and (ym >= min(y3, y2)) then
    Nast := true
  else
    equ2 := Sign(xm - xsr) = Sign(x2 - xsr);
  
  if x3 <> x1 then 
  begin
    k3 := (y3 - y1) / (x3 - x1);
    b3 := y3 - k3 * x3;
    equ3 := (Sign(Side(k3, b3, xm, ym)) = Sign(Side(k3, b3, xsr, ysr)) );
  end
  else
  if (xm = x3) and (ym <= max(y3, y1)) and (ym >= min(y3, y1)) then
    Nast := true
  else
    equ3 := (Sign(xm - xsr) = Sign(x3 - xsr));
  
  if Nast or (Side(k1, b1, xm, ym) = 0) or (Side(k2, b2, xm, ym) = 0) 
  or (Side(k3, b3, xm, ym) = 0) then
    writeln('точка лежит на стороне треугольника')
  else
  if equ1 and equ2 and equ3 then
    writeln('точка лежит внутри треугольника')
  else
    writeln('точка лежит вне треугольника');
end.

[je_day]

Задача о нахождении точки внутри и на сторонах заданного треугольника. Программа определяет нахождение точки, если точка и вершина треугольника находятся на одной строне от противолежащей стороны(правильность такого условия для трех сторон гаранитирует нахождение точки в пределах треугольника).

var a,x1,x2,x3,y1,y2,y3,x,y:real;
    f1:boolean;
function sides(x,y,x1,y1,x2,y2:real):real;
 begin
   result:=(y1-y2)/(x1-x2)*(x-x1)+(y1-y);
 end;    
begin
 writeln('x,y');
 readln(x,y);
 writeln('x1,y1');
 readln(x1,y1);
 writeln('x2,y2');
 readln(x2,y2);
 writeln('x3,y3');
 readln(x3,y3);
 a:=sides(x,y,x1,y1,x2,y2);
 f1:=(a*sides(x3,y3,x1,y1,x2,y2)>=0);// для стороны x1y1_x2y2
 f1:=f1 and ((a*sides(x1,y1,x3,y3,x2,y2))>=0); // для стороны x3y3_x2y2
 f1:=f1 and ((a*sides(x2,y2,x3,y3,x1,y1))>=0); // для стороны x3y3_x1y1
 writeln('Точка в треугольнике:',f1);
end.

[John_Hannibal_Smit]

x,y
0.5
0.5
x1,y1
0 0
x2,y2
1 2
x3,y3
2 1
Точка в треугольнике:False
x,y
0 0
x1,y1
2 1
x2,y2
1 2
x3,y3
0.5 0.5
Точка в треугольнике:False

не стал разбираться какая именно точка m (из х и y или x3 и y3), но точка 0,5 0,5 лежит в этом треугольнике, что можно проверить на графике, кстати, меня тоже не работает, так чт о не расстраивайся!

[je_day]

Она как и моя прошлая программа работает в 75% случаев, что тоже ничего.