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

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

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

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.

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

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

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

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

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

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

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

//в данном решении выбирается прямые , на которых лежат 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.

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

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.

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

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

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

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

О,спасибо)

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

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:=(kx-k1x+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:=(k1x1-kx+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.

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

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


программа основана на формуле нахождения расстояния от точки до прямой. Сначала определяется ,
с какой стороны прямых, на которой лежат стороны треугольника лежит наша точка.
для этого мы берем точку внутри треугольника,
которой является ее центр, и сравниваем, лежат ли точка 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.

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


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.
1 лайк

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 лежит в этом треугольнике, что можно проверить на графике, кстати, меня тоже не работает, так чт о не расстраивайся!

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