К сегодняшней лекции: программа, которая делает 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.
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% случаев, что тоже ничего.